mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-11 19:48:09 +02:00
3682 lines
85 KiB
ObjectPascal
3682 lines
85 KiB
ObjectPascal
{
|
|
$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.
|
|
|
|
**********************************************************************}
|
|
Unit Linux;
|
|
Interface
|
|
|
|
{ Get Types and Constants }
|
|
{$i sysconst.inc}
|
|
{$i systypes.inc}
|
|
|
|
{ Get System call numbers and error-numbers}
|
|
{$i sysnr.inc}
|
|
{$i errno.inc}
|
|
|
|
var
|
|
ErrNo,
|
|
LinuxError : Longint;
|
|
|
|
|
|
{********************
|
|
Process
|
|
********************}
|
|
|
|
const
|
|
{ cloning flags }
|
|
CSIGNAL = $000000ff; // signal mask to be sent at exit
|
|
CLONE_VM = $00000100; // set if VM shared between processes
|
|
CLONE_FS = $00000200; // set if fs info shared between processes
|
|
CLONE_FILES = $00000400; // set if open files shared between processes
|
|
CLONE_SIGHAND = $00000800; // set if signal handlers shared
|
|
CLONE_PID = $00001000; // set if pid shared
|
|
type
|
|
TCloneFunc=function(args:pointer):longint;cdecl;
|
|
|
|
const
|
|
{ For getting/setting priority }
|
|
Prio_Process = 0;
|
|
Prio_PGrp = 1;
|
|
Prio_User = 2;
|
|
|
|
WNOHANG = $1;
|
|
WUNTRACED = $2;
|
|
__WCLONE = $80000000;
|
|
|
|
|
|
{********************
|
|
File
|
|
********************}
|
|
|
|
Const
|
|
P_IN = 1;
|
|
P_OUT = 2;
|
|
|
|
Const
|
|
LOCK_SH = 1;
|
|
LOCK_EX = 2;
|
|
LOCK_UN = 8;
|
|
LOCK_NB = 4;
|
|
|
|
|
|
Type
|
|
Tpipe = array[1..2] of longint;
|
|
|
|
pglob = ^tglob;
|
|
tglob = record
|
|
name : pchar;
|
|
next : pglob;
|
|
end;
|
|
|
|
ComStr = String[255];
|
|
PathStr = String[255];
|
|
DirStr = String[255];
|
|
NameStr = String[255];
|
|
ExtStr = String[255];
|
|
|
|
const
|
|
|
|
{ For testing access rights }
|
|
R_OK = 4;
|
|
W_OK = 2;
|
|
X_OK = 1;
|
|
F_OK = 0;
|
|
|
|
{ For File control mechanism }
|
|
F_GetFd = 1;
|
|
F_SetFd = 2;
|
|
F_GetFl = 3;
|
|
F_SetFl = 4;
|
|
F_GetLk = 5;
|
|
F_SetLk = 6;
|
|
F_SetLkW = 7;
|
|
F_GetOwn = 8;
|
|
F_SetOwn = 9;
|
|
|
|
|
|
|
|
{********************
|
|
Signal
|
|
********************}
|
|
|
|
Const
|
|
{ For sending a signal }
|
|
SA_NOCLDSTOP = 1;
|
|
SA_SHIRQ = $04000000;
|
|
SA_STACK = $08000000;
|
|
SA_RESTART = $10000000;
|
|
SA_INTERRUPT = $20000000;
|
|
SA_NOMASK = $40000000;
|
|
SA_ONESHOT = $80000000;
|
|
|
|
SIG_BLOCK = 0;
|
|
SIG_UNBLOCK = 1;
|
|
SIG_SETMASK = 2;
|
|
|
|
SIG_DFL = 0 ;
|
|
SIG_IGN = 1 ;
|
|
SIG_ERR = -1 ;
|
|
|
|
SIGHUP = 1;
|
|
SIGINT = 2;
|
|
SIGQUIT = 3;
|
|
SIGILL = 4;
|
|
SIGTRAP = 5;
|
|
SIGABRT = 6;
|
|
SIGIOT = 6;
|
|
SIGBUS = 7;
|
|
SIGFPE = 8;
|
|
SIGKILL = 9;
|
|
SIGUSR1 = 10;
|
|
SIGSEGV = 11;
|
|
SIGUSR2 = 12;
|
|
SIGPIPE = 13;
|
|
SIGALRM = 14;
|
|
SIGTerm = 15;
|
|
SIGSTKFLT = 16;
|
|
SIGCHLD = 17;
|
|
SIGCONT = 18;
|
|
SIGSTOP = 19;
|
|
SIGTSTP = 20;
|
|
SIGTTIN = 21;
|
|
SIGTTOU = 22;
|
|
SIGURG = 23;
|
|
SIGXCPU = 24;
|
|
SIGXFSZ = 25;
|
|
SIGVTALRM = 26;
|
|
SIGPROF = 27;
|
|
SIGWINCH = 28;
|
|
SIGIO = 29;
|
|
SIGPOLL = SIGIO;
|
|
SIGPWR = 30;
|
|
SIGUNUSED = 31;
|
|
|
|
Type
|
|
SignalHandler = Procedure(Sig : LongInt);cdecl;
|
|
PSignalHandler = ^SignalHandler;
|
|
SignalRestorer = Procedure;cdecl;
|
|
PSignalRestorer = ^SignalRestorer;
|
|
|
|
SigSet = Longint;
|
|
PSigSet = ^SigSet;
|
|
|
|
SigActionRec = packed record
|
|
Sa_Handler : SignalHandler;
|
|
Sa_Mask : SigSet;
|
|
Sa_Flags : Longint;
|
|
{ Sa_restorer : SignalRestorer; }
|
|
end;
|
|
PSigActionRec = ^SigActionRec;
|
|
|
|
|
|
{********************
|
|
IOCtl(TermIOS)
|
|
********************}
|
|
|
|
Const
|
|
{ Amount of Control Chars }
|
|
NCCS = 19;
|
|
NCC = 8;
|
|
|
|
{ For Terminal handling }
|
|
TCGETS = $5401;
|
|
TCSETS = $5402;
|
|
TCSETSW = $5403;
|
|
TCSETSF = $5404;
|
|
TCGETA = $5405;
|
|
TCSETA = $5406;
|
|
TCSETAW = $5407;
|
|
TCSETAF = $5408;
|
|
TCSBRK = $5409;
|
|
TCXONC = $540A;
|
|
TCFLSH = $540B;
|
|
TIOCEXCL = $540C;
|
|
TIOCNXCL = $540D;
|
|
TIOCSCTTY = $540E;
|
|
TIOCGPGRP = $540F;
|
|
TIOCSPGRP = $5410;
|
|
TIOCOUTQ = $5411;
|
|
TIOCSTI = $5412;
|
|
TIOCGWINSZ = $5413;
|
|
TIOCSWINSZ = $5414;
|
|
TIOCMGET = $5415;
|
|
TIOCMBIS = $5416;
|
|
TIOCMBIC = $5417;
|
|
TIOCMSET = $5418;
|
|
TIOCGSOFTCAR = $5419;
|
|
TIOCSSOFTCAR = $541A;
|
|
FIONREAD = $541B;
|
|
TIOCINQ = FIONREAD;
|
|
TIOCLINUX = $541C;
|
|
TIOCCONS = $541D;
|
|
TIOCGSERIAL = $541E;
|
|
TIOCSSERIAL = $541F;
|
|
TIOCPKT = $5420;
|
|
FIONBIO = $5421;
|
|
TIOCNOTTY = $5422;
|
|
TIOCSETD = $5423;
|
|
TIOCGETD = $5424;
|
|
TCSBRKP = $5425;
|
|
TIOCTTYGSTRUCT = $5426;
|
|
FIONCLEX = $5450;
|
|
FIOCLEX = $5451;
|
|
FIOASYNC = $5452;
|
|
TIOCSERCONFIG = $5453;
|
|
TIOCSERGWILD = $5454;
|
|
TIOCSERSWILD = $5455;
|
|
TIOCGLCKTRMIOS = $5456;
|
|
TIOCSLCKTRMIOS = $5457;
|
|
TIOCSERGSTRUCT = $5458;
|
|
TIOCSERGETLSR = $5459;
|
|
TIOCSERGETMULTI = $545A;
|
|
TIOCSERSETMULTI = $545B;
|
|
|
|
TIOCMIWAIT = $545C;
|
|
TIOCGICOUNT = $545D;
|
|
TIOCPKT_DATA = 0;
|
|
TIOCPKT_FLUSHREAD = 1;
|
|
TIOCPKT_FLUSHWRITE = 2;
|
|
TIOCPKT_STOP = 4;
|
|
TIOCPKT_START = 8;
|
|
TIOCPKT_NOSTOP = 16;
|
|
TIOCPKT_DOSTOP = 32;
|
|
|
|
|
|
Type
|
|
winsize = packed record
|
|
ws_row,
|
|
ws_col,
|
|
ws_xpixel,
|
|
ws_ypixel : word;
|
|
end;
|
|
TWinSize=winsize;
|
|
|
|
Termio = packed record
|
|
c_iflag, { input mode flags }
|
|
c_oflag, { output mode flags }
|
|
c_cflag, { control mode flags }
|
|
c_lflag : Word; { local mode flags }
|
|
c_line : Word; { line discipline - careful, only High byte in use}
|
|
c_cc : array [0..NCC-1] of char;{ control characters }
|
|
end;
|
|
TTermio=Termio;
|
|
|
|
Termios = packed record
|
|
c_iflag,
|
|
c_oflag,
|
|
c_cflag,
|
|
c_lflag : longint;
|
|
c_line : char;
|
|
c_cc : array[0..NCCS-1] of byte;
|
|
end;
|
|
TTermios=Termios;
|
|
|
|
const
|
|
InitCC:array[0..NCCS-1] of byte=(3,34,177,25,4,0,1,0,21,23,32,0,22,17,27,26,0,0,0);
|
|
|
|
const
|
|
{c_cc characters}
|
|
VINTR = 0;
|
|
VQUIT = 1;
|
|
VERASE = 2;
|
|
VKILL = 3;
|
|
VEOF = 4;
|
|
VTIME = 5;
|
|
VMIN = 6;
|
|
VSWTC = 7;
|
|
VSTART = 8;
|
|
VSTOP = 9;
|
|
VSUSP = 10;
|
|
VEOL = 11;
|
|
VREPRINT = 12;
|
|
VDISCARD = 13;
|
|
VWERASE = 14;
|
|
VLNEXT = 15;
|
|
VEOL2 = 16;
|
|
|
|
{c_iflag bits}
|
|
IGNBRK = $0000001;
|
|
BRKINT = $0000002;
|
|
IGNPAR = $0000004;
|
|
PARMRK = $0000008;
|
|
INPCK = $0000010;
|
|
ISTRIP = $0000020;
|
|
INLCR = $0000040;
|
|
IGNCR = $0000080;
|
|
ICRNL = $0000100;
|
|
IUCLC = $0000200;
|
|
IXON = $0000400;
|
|
IXANY = $0000800;
|
|
IXOFF = $0001000;
|
|
IMAXBEL = $0002000;
|
|
|
|
{c_oflag bits}
|
|
OPOST = $0000001;
|
|
OLCUC = $0000002;
|
|
ONLCR = $0000004;
|
|
OCRNL = $0000008;
|
|
ONOCR = $0000010;
|
|
ONLRET = $0000020;
|
|
OFILL = $0000040;
|
|
OFDEL = $0000080;
|
|
NLDLY = $0000100;
|
|
NL0 = $0000000;
|
|
NL1 = $0000100;
|
|
CRDLY = $0000600;
|
|
CR0 = $0000000;
|
|
CR1 = $0000200;
|
|
CR2 = $0000400;
|
|
CR3 = $0000600;
|
|
TABDLY = $0001800;
|
|
TAB0 = $0000000;
|
|
TAB1 = $0000800;
|
|
TAB2 = $0001000;
|
|
TAB3 = $0001800;
|
|
XTABS = $0001800;
|
|
BSDLY = $0002000;
|
|
BS0 = $0000000;
|
|
BS1 = $0002000;
|
|
VTDLY = $0004000;
|
|
VT0 = $0000000;
|
|
VT1 = $0004000;
|
|
FFDLY = $0008000;
|
|
FF0 = $0000000;
|
|
FF1 = $0008000;
|
|
|
|
{c_cflag bits}
|
|
CBAUD = $000100F;
|
|
B0 = $0000000;
|
|
B50 = $0000001;
|
|
B75 = $0000002;
|
|
B110 = $0000003;
|
|
B134 = $0000004;
|
|
B150 = $0000005;
|
|
B200 = $0000006;
|
|
B300 = $0000007;
|
|
B600 = $0000008;
|
|
B1200 = $0000009;
|
|
B1800 = $000000A;
|
|
B2400 = $000000B;
|
|
B4800 = $000000C;
|
|
B9600 = $000000D;
|
|
B19200 = $000000E;
|
|
B38400 = $000000F;
|
|
EXTA = B19200;
|
|
EXTB = B38400;
|
|
CSIZE = $0000030;
|
|
CS5 = $0000000;
|
|
CS6 = $0000010;
|
|
CS7 = $0000020;
|
|
CS8 = $0000030;
|
|
CSTOPB = $0000040;
|
|
CREAD = $0000080;
|
|
PARENB = $0000100;
|
|
PARODD = $0000200;
|
|
HUPCL = $0000400;
|
|
CLOCAL = $0000800;
|
|
CBAUDEX = $0001000;
|
|
B57600 = $0001001;
|
|
B115200 = $0001002;
|
|
B230400 = $0001003;
|
|
B460800 = $0001004;
|
|
CIBAUD = $100F0000;
|
|
CMSPAR = $40000000;
|
|
CRTSCTS = $80000000;
|
|
|
|
{c_lflag bits}
|
|
ISIG = $0000001;
|
|
ICANON = $0000002;
|
|
XCASE = $0000004;
|
|
ECHO = $0000008;
|
|
ECHOE = $0000010;
|
|
ECHOK = $0000020;
|
|
ECHONL = $0000040;
|
|
NOFLSH = $0000080;
|
|
TOSTOP = $0000100;
|
|
ECHOCTL = $0000200;
|
|
ECHOPRT = $0000400;
|
|
ECHOKE = $0000800;
|
|
FLUSHO = $0001000;
|
|
PENDIN = $0004000;
|
|
IEXTEN = $0008000;
|
|
|
|
{c_line bits}
|
|
TIOCM_LE = $001;
|
|
TIOCM_DTR = $002;
|
|
TIOCM_RTS = $004;
|
|
TIOCM_ST = $008;
|
|
TIOCM_SR = $010;
|
|
TIOCM_CTS = $020;
|
|
TIOCM_CAR = $040;
|
|
TIOCM_RNG = $080;
|
|
TIOCM_DSR = $100;
|
|
TIOCM_CD = TIOCM_CAR;
|
|
TIOCM_RI = TIOCM_RNG;
|
|
TIOCM_OUT1 = $2000;
|
|
TIOCM_OUT2 = $4000;
|
|
|
|
{TCSetAttr}
|
|
TCSANOW = 0;
|
|
TCSADRAIN = 1;
|
|
TCSAFLUSH = 2;
|
|
|
|
{TCFlow}
|
|
TCOOFF = 0;
|
|
TCOON = 1;
|
|
TCIOFF = 2;
|
|
TCION = 3;
|
|
|
|
{TCFlush}
|
|
TCIFLUSH = 0;
|
|
TCOFLUSH = 1;
|
|
TCIOFLUSH = 2;
|
|
|
|
|
|
{********************
|
|
Info
|
|
********************}
|
|
|
|
Type
|
|
UTimBuf = packed record {in BSD array[0..1] of timeval, but this is
|
|
backwards compatible with linux version}
|
|
actime,
|
|
dummy1,
|
|
modtime,
|
|
dummy2 : Longint;
|
|
end;
|
|
|
|
UTimeBuf=UTimBuf;
|
|
TUTimeBuf=UTimeBuf;
|
|
PUTimeBuf=^UTimeBuf;
|
|
|
|
TSysinfo = packed record
|
|
uptime : longint;
|
|
loads : array[1..3] of longint;
|
|
totalram,
|
|
freeram,
|
|
sharedram,
|
|
bufferram,
|
|
totalswap,
|
|
freeswap : longint;
|
|
procs : integer;
|
|
s : string[18];
|
|
end;
|
|
PSysInfo = ^TSysInfo;
|
|
|
|
{******************************************************************************
|
|
Procedure/Functions
|
|
******************************************************************************}
|
|
|
|
//Function SysCall(callnr:longint;var regs:SysCallregs):longint;
|
|
|
|
{**************************
|
|
Time/Date Handling
|
|
***************************}
|
|
|
|
var
|
|
tzdaylight : boolean;
|
|
tzseconds : longint;
|
|
tzname : array[boolean] of pchar;
|
|
|
|
{ timezone support }
|
|
procedure GetLocalTimezone(timer:longint;var leap_correct,leap_hit:longint);
|
|
procedure GetLocalTimezone(timer:longint);
|
|
procedure ReadTimezoneFile(fn:string);
|
|
function GetTimezoneFile:string;
|
|
|
|
Procedure GetTimeOfDay(var tv:timeval);
|
|
Function GetTimeOfDay:longint;
|
|
Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
|
|
Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
|
|
procedure GetTime(var hour,min,sec,msec,usec:word);
|
|
procedure GetTime(var hour,min,sec,sec100:word);
|
|
procedure GetTime(var hour,min,sec:word);
|
|
Procedure GetDate(Var Year,Month,Day:Word);
|
|
Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
|
|
|
|
{**************************
|
|
Process Handling
|
|
***************************}
|
|
|
|
function CreateShellArgV(const prog:string):ppchar;
|
|
function CreateShellArgV(const prog:Ansistring):ppchar;
|
|
Procedure Execve(Path:pathstr;args:ppchar;ep:ppchar);
|
|
Procedure Execve(path:pchar;args:ppchar;ep:ppchar);
|
|
Procedure Execv(const path:pathstr;args:ppchar);
|
|
Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
|
|
Procedure Execl(const Todo:string);
|
|
Procedure Execle(Todo:string;Ep:ppchar);
|
|
Procedure Execlp(Todo:string;Ep:ppchar);
|
|
Function Shell(const Command:String):Longint;
|
|
Function Shell(const Command:AnsiString):Longint;
|
|
Function Fork:longint;
|
|
function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
|
|
Procedure ExitProcess(val:longint);
|
|
Function WaitPid(Pid:longint;Status:pointer;Options:Integer):Longint;
|
|
Procedure Nice(N:integer);
|
|
Function GetPriority(Which,Who:longint):longint;
|
|
Procedure SetPriority(Which,Who,What:longint);
|
|
Function GetPid:LongInt;
|
|
Function GetPPid:LongInt;
|
|
Function GetUid:Longint;
|
|
Function GetEUid:Longint;
|
|
Function GetGid:Longint;
|
|
Function GetEGid:Longint;
|
|
|
|
{**************************
|
|
File Handling
|
|
***************************}
|
|
|
|
Function fdOpen(pathname:string;flags:longint):longint;
|
|
Function fdOpen(pathname:string;flags,mode:longint):longint;
|
|
Function fdOpen(pathname:pchar;flags:longint):longint;
|
|
Function fdOpen(pathname:pchar;flags,mode:longint):longint;
|
|
Function fdClose(fd:longint):boolean;
|
|
Function fdRead(fd:longint;var buf;size:longint):longint;
|
|
Function fdWrite(fd:longint;var buf;size:longint):longint;
|
|
Function fdTruncate(fd,size:longint):boolean;
|
|
Function fdSeek (fd,pos,seektype :longint): longint;
|
|
Function fdFlush (fd : Longint) : Boolean;
|
|
Function Link(OldPath,NewPath:pathstr):boolean;
|
|
Function SymLink(OldPath,NewPath:pathstr):boolean;
|
|
Function UnLink(Path:pathstr):boolean;
|
|
Function UnLink(Path:pchar):Boolean;
|
|
Function FReName (OldName,NewName : Pchar) : Boolean;
|
|
Function FReName (OldName,NewName : String) : Boolean;
|
|
Function Chown(path:pathstr;NewUid,NewGid:longint):boolean;
|
|
Function Chmod(path:pathstr;Newmode:longint):boolean;
|
|
Function Utime(path:pathstr;utim:utimebuf):boolean;
|
|
Function Access(Path:Pathstr ;mode:longint):boolean;
|
|
Function Umask(Mask:Integer):integer;
|
|
Function Flock (fd,mode : longint) : boolean;
|
|
Function Flock (var T : text;mode : longint) : boolean;
|
|
Function Flock (var F : File;mode : longint) : boolean;
|
|
Function FStat(Path:Pathstr;Var Info:stat):Boolean;
|
|
Function FStat(Fd:longint;Var Info:stat):Boolean;
|
|
Function FStat(var F:Text;Var Info:stat):Boolean;
|
|
Function FStat(var F:File;Var Info:stat):Boolean;
|
|
Function Lstat(Filename: PathStr;var Info:stat):Boolean;
|
|
Function FSStat(Path:Pathstr;Var Info:statfs):Boolean;
|
|
Function FSStat(Fd: Longint;Var Info:statfs):Boolean;
|
|
Function Fcntl(Fd:longint;Cmd:longint):longint;
|
|
Procedure Fcntl(Fd:longint;Cmd:longint;Arg:Longint);
|
|
Function Fcntl(var Fd:Text;Cmd:longint):longint;
|
|
Procedure Fcntl(var Fd:Text;Cmd:longint;Arg:Longint);
|
|
Function Dup(oldfile:longint;var newfile:longint):Boolean;
|
|
Function Dup(var oldfile,newfile:text):Boolean;
|
|
Function Dup(var oldfile,newfile:file):Boolean;
|
|
Function Dup2(oldfile,newfile:longint):Boolean;
|
|
Function Dup2(var oldfile,newfile:text):Boolean;
|
|
Function Dup2(var oldfile,newfile:file):Boolean;
|
|
|
|
Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
|
|
Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
|
|
|
|
Function SelectText(var T:Text;TimeOut :PTimeVal):Longint;
|
|
|
|
{**************************
|
|
Directory Handling
|
|
***************************}
|
|
|
|
Function OpenDir(f:pchar):pdir;
|
|
Function OpenDir(f: String):pdir;
|
|
function CloseDir(p:pdir):integer;
|
|
Function ReadDir(p:pdir):pdirent;
|
|
procedure SeekDir(p:pdir;off:longint);
|
|
function TellDir(p:pdir):longint;
|
|
|
|
{**************************
|
|
Pipe/Fifo/Stream
|
|
***************************}
|
|
|
|
Function AssignPipe(var pipe_in,pipe_out:longint):boolean;
|
|
Function AssignPipe(var pipe_in,pipe_out:text):boolean;
|
|
Function AssignPipe(var pipe_in,pipe_out:file):boolean;
|
|
Function PClose(Var F:text) : longint;
|
|
Function PClose(Var F:file) : longint;
|
|
Procedure POpen(var F:text;const Prog:String;rw:char);
|
|
Procedure POpen(var F:file;const Prog:String;rw:char);
|
|
|
|
Function mkFifo(pathname:string;mode:longint):boolean;
|
|
|
|
Procedure AssignStream(Var StreamIn,Streamout:text;Const Prog:String);
|
|
function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: String): LongInt;
|
|
|
|
{**************************
|
|
General information
|
|
***************************}
|
|
|
|
{
|
|
Function GetDomainName:String;
|
|
Function GetHostName:String;
|
|
Function Sysinfo(var Info:TSysinfo):Boolean;
|
|
Function Uname(var unamerec:utsname):Boolean;
|
|
}
|
|
Function GetEnv(P:string):Pchar;
|
|
|
|
{**************************
|
|
Signal
|
|
***************************}
|
|
|
|
Procedure SigAction(Signum:Integer;Var Act,OldAct:PSigActionRec );
|
|
Procedure SigProcMask (How:Integer;SSet,OldSSet:PSigSet);
|
|
Function SigPending:SigSet;
|
|
Procedure SigSuspend(Mask:Sigset);
|
|
//Function Signal(Signum:Integer;Handler:SignalHandler):SignalHandler;
|
|
Function Kill(Pid:longint;Sig:integer):integer;
|
|
Procedure SigRaise(Sig:integer);
|
|
{Function Alarm(Sec : Longint) : longint;
|
|
Procedure Pause;
|
|
}
|
|
{**************************
|
|
IOCtl/Termios Functions
|
|
***************************}
|
|
|
|
Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean;
|
|
Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
|
|
Function TCSetAttr(fd:longint;OptAct:longint;var tios:TermIOS):boolean;
|
|
Procedure CFSetISpeed(var tios:TermIOS;speed:Longint);
|
|
Procedure CFSetOSpeed(var tios:TermIOS;speed:Longint);
|
|
Procedure CFMakeRaw(var tios:TermIOS);
|
|
Function TCSendBreak(fd,duration:longint):boolean;
|
|
Function TCSetPGrp(fd,id:longint):boolean;
|
|
Function TCGetPGrp(fd:longint;var id:longint):boolean;
|
|
Function TCFlush(fd,qsel:longint):boolean;
|
|
Function TCDrain(fd:longint):boolean;
|
|
Function TCFlow(fd,act:longint):boolean;
|
|
Function IsATTY(Handle:Longint):Boolean;
|
|
Function IsATTY(f:text):Boolean;
|
|
function TTYname(Handle:Longint):string;
|
|
function TTYname(var F:Text):string;
|
|
|
|
{**************************
|
|
Memory functions
|
|
***************************}
|
|
|
|
const
|
|
PROT_READ = $1; { page can be read }
|
|
PROT_WRITE = $2; { page can be written }
|
|
PROT_EXEC = $4; { page can be executed }
|
|
PROT_NONE = $0; { page can not be accessed }
|
|
|
|
MAP_SHARED = $1; { Share changes }
|
|
MAP_PRIVATE = $2; { Changes are private }
|
|
MAP_TYPE = $f; { Mask for type of mapping }
|
|
MAP_FIXED = $10; { Interpret addr exactly }
|
|
MAP_ANONYMOUS = $20; { don't use a file }
|
|
|
|
MAP_GROWSDOWN = $100; { stack-like segment }
|
|
MAP_DENYWRITE = $800; { ETXTBSY }
|
|
MAP_EXECUTABLE = $1000; { mark it as an executable }
|
|
MAP_LOCKED = $2000; { pages are locked }
|
|
MAP_NORESERVE = $4000; { don't check for reservations }
|
|
|
|
type
|
|
tmmapargs=record
|
|
address : longint;
|
|
size : longint;
|
|
prot : longint;
|
|
flags : longint;
|
|
fd : longint;
|
|
offset : longint;
|
|
end;
|
|
|
|
function MMap(const m:tmmapargs):longint;
|
|
|
|
|
|
{**************************
|
|
Port IO functions
|
|
***************************}
|
|
|
|
{
|
|
Function IOperm (From,Num : Cardinal; Value : Longint) : boolean;
|
|
}
|
|
{$IFDEF I386}
|
|
Procedure WritePort (Port : Longint; Value : Byte);
|
|
Procedure WritePort (Port : Longint; Value : Word);
|
|
Procedure WritePort (Port : Longint; Value : Longint);
|
|
Procedure WritePortl (Port : Longint; Var Buf; Count: longint);
|
|
Procedure WritePortW (Port : Longint; Var Buf; Count: longint);
|
|
Procedure WritePortB (Port : Longint; Var Buf; Count: longint);
|
|
Procedure ReadPort (Port : Longint; Var Value : Byte);
|
|
Procedure ReadPort (Port : Longint; Var Value : Word);
|
|
Procedure ReadPort (Port : Longint; Var Value : Longint);
|
|
Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);
|
|
Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);
|
|
Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);
|
|
{$ENDIF}
|
|
|
|
{**************************
|
|
Utility functions
|
|
***************************}
|
|
|
|
Function Octal(l:longint):longint;
|
|
Function FExpand(Const Path: PathStr):PathStr;
|
|
Function FSearch(const path:pathstr;dirlist:string):pathstr;
|
|
Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
|
|
Function Dirname(Const path:pathstr):pathstr;
|
|
Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
|
|
Function FNMatch(const Pattern,Name:string):Boolean;
|
|
Function Glob(Const path:pathstr):pglob;
|
|
Procedure Globfree(var p:pglob);
|
|
Function StringToPPChar(Var S:STring):ppchar;
|
|
Function GetFS(var T:Text):longint;
|
|
Function GetFS(Var F:File):longint;
|
|
{Filedescriptorsets}
|
|
Procedure FD_Zero(var fds:fdSet);
|
|
Procedure FD_Clr(fd:longint;var fds:fdSet);
|
|
Procedure FD_Set(fd:longint;var fds:fdSet);
|
|
Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
|
|
{Stat.Mode Types}
|
|
Function S_ISLNK(m:word):boolean;
|
|
Function S_ISREG(m:word):boolean;
|
|
Function S_ISDIR(m:word):boolean;
|
|
|
|
Function S_ISCHR(m:word):boolean;
|
|
Function S_ISBLK(m:word):boolean;
|
|
Function S_ISFIFO(m:word):boolean;
|
|
Function S_ISSOCK(m:word):boolean;
|
|
|
|
|
|
{******************************************************************************
|
|
Implementation
|
|
******************************************************************************}
|
|
|
|
Implementation
|
|
|
|
Uses Strings;
|
|
|
|
|
|
{ Get the definitions of textrec and filerec }
|
|
{$i textrec.inc}
|
|
{$i filerec.inc}
|
|
|
|
{This seems ridiculus, but the proc name gets $linux$ prefixed, the external
|
|
not}
|
|
procedure _actualsyscall; external '_actualsyscall';
|
|
|
|
{ Raw System calls are in Syscalls.inc}
|
|
{$i syscalls.inc}
|
|
|
|
|
|
|
|
{******************************************************************************
|
|
Process related calls
|
|
******************************************************************************}
|
|
|
|
function CreateShellArgV(const prog:string):ppchar;
|
|
{
|
|
Create an argv which executes a command in a shell using /bin/sh -c
|
|
}
|
|
var
|
|
pp,p : ppchar;
|
|
temp : string;
|
|
begin
|
|
getmem(pp,4*4);
|
|
temp:='/bin/sh'#0'-c'#0+prog+#0;
|
|
p:=pp;
|
|
p^:=@temp[1];
|
|
inc(p);
|
|
p^:=@temp[9];
|
|
inc(p);
|
|
p^:=@temp[12];
|
|
inc(p);
|
|
p^:=Nil;
|
|
CreateShellArgV:=pp;
|
|
end;
|
|
|
|
function CreateShellArgV(const prog:Ansistring):ppchar;
|
|
{
|
|
Create an argv which executes a command in a shell using /bin/sh -c
|
|
using a AnsiString;
|
|
}
|
|
var
|
|
pp,p : ppchar;
|
|
temp : AnsiString;
|
|
begin
|
|
getmem(pp,4*4);
|
|
temp:='/bin/sh'#0'-c'#0+prog+#0;
|
|
p:=pp;
|
|
GetMem(p^,Length(Temp));
|
|
Move(@Temp[1],p^^,Length(Temp));
|
|
inc(p);
|
|
p^:=@pp[0][8];
|
|
inc(p);
|
|
p^:=@pp[0][11];
|
|
inc(p);
|
|
p^:=Nil;
|
|
CreateShellArgV:=pp;
|
|
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.
|
|
}
|
|
|
|
Begin
|
|
fork:=Do_syscall(SysCall_nr_fork);
|
|
LinuxError:=ErrNo;
|
|
End;
|
|
|
|
|
|
function clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
|
|
{NOT IMPLEMENTED YET UNDER BSD}
|
|
begin
|
|
HALT;
|
|
END;
|
|
{
|
|
if (pointer(func)=nil) or (sp=nil) then
|
|
begin
|
|
LinuxError:=Sys_EInval;
|
|
exit;
|
|
end;
|
|
asm
|
|
{ Insert the argument onto the new stack. }
|
|
movl sp,%ecx
|
|
subl $8,%ecx
|
|
movl args,%eax
|
|
movl %eax,4(%ecx)
|
|
|
|
{ Save the function pointer as the zeroth argument.
|
|
It will be popped off in the child in the ebx frobbing below. }
|
|
movl func,%eax
|
|
movl %eax,0(%ecx)
|
|
|
|
{ Do the system call }
|
|
pushl %ebx
|
|
pushl %ebx
|
|
// movl flags,%ebx
|
|
movl $251,%eax
|
|
int $0x80
|
|
popl %ebx
|
|
popl %ebx
|
|
test %eax,%eax
|
|
jnz .Lclone_end
|
|
|
|
{ We're in the new thread }
|
|
subl %ebp,%ebp { terminate the stack frame }
|
|
call *%ebx
|
|
{ exit process }
|
|
movl %eax,%ebx
|
|
movl $1,%eax
|
|
int $0x80
|
|
|
|
.Lclone_end:
|
|
movl %eax,__RESULT
|
|
end;
|
|
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;
|
|
do_syscall(syscall_nr_Execve,longint(@path[1]),longint(Args),longint(ep));
|
|
LinuxError:=ErrNo;
|
|
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.
|
|
}
|
|
|
|
{
|
|
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
|
|
do_syscall(syscall_nr_Execve,longint(path),longint(Args),longint(ep));
|
|
LinuxError:=ErrNo;
|
|
End;
|
|
|
|
|
|
Procedure Execv(const path:pathstr;args:ppchar);
|
|
{
|
|
Replaces the current program by the program specified in path,
|
|
arguments in args are passed to Execve.
|
|
the current environment is passed on.
|
|
}
|
|
begin
|
|
Execve(path,args,envp); {On error linuxerror will get set there}
|
|
end;
|
|
|
|
Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
|
|
{
|
|
This does the same as Execve, only it searches the PATH environment
|
|
for the place of the Executable, except when Path starts with a slash.
|
|
if the PATH environment variable is unavailable, the path is set to '.'
|
|
}
|
|
var
|
|
thepath : string;
|
|
begin
|
|
if path[1]<>'/' then
|
|
begin
|
|
Thepath:=strpas(getenv('PATH'));
|
|
if thepath='' then
|
|
thepath:='.';
|
|
Path:=FSearch(path,thepath)
|
|
end
|
|
else
|
|
Path:='';
|
|
if Path='' then
|
|
linuxerror:=Sys_enoent
|
|
else
|
|
Execve(Path,args,ep);{On error linuxerror will get set there}
|
|
end;
|
|
|
|
Procedure Execle(Todo:string;Ep:ppchar);
|
|
{
|
|
This procedure takes the string 'Todo', parses it for command and
|
|
command options, and Executes the command with the given options.
|
|
The string 'Todo' shoud be of the form 'command options', options
|
|
separated by commas.
|
|
the PATH environment is not searched for 'command'.
|
|
The specified environment(in 'ep') is passed on to command
|
|
}
|
|
var
|
|
p : ppchar;
|
|
begin
|
|
p:=StringToPPChar(ToDo);
|
|
if (p=nil) or (p^=nil) then
|
|
exit;
|
|
ExecVE(p^,p,EP);
|
|
end;
|
|
|
|
|
|
|
|
Procedure Execl(const Todo:string);
|
|
{
|
|
This procedure takes the string 'Todo', parses it for command and
|
|
command options, and Executes the command with the given options.
|
|
The string 'Todo' shoud be of the form 'command options', options
|
|
separated by commas.
|
|
the PATH environment is not searched for 'command'.
|
|
The current environment is passed on to command
|
|
}
|
|
begin
|
|
ExecLE(ToDo,EnvP);
|
|
end;
|
|
|
|
|
|
|
|
Procedure Execlp(Todo:string;Ep:ppchar);
|
|
{
|
|
This procedure takes the string 'Todo', parses it for command and
|
|
command options, and Executes the command with the given options.
|
|
The string 'Todo' shoud be of the form 'command options', options
|
|
separated by commas.
|
|
the PATH environment is searched for 'command'.
|
|
The specified environment (in 'ep') is passed on to command
|
|
}
|
|
var
|
|
p : ppchar;
|
|
begin
|
|
p:=StringToPPchar(todo);
|
|
if (p=nil) or (p^=nil) then
|
|
exit;
|
|
ExecVP(StrPas(p^),p,EP);
|
|
end;
|
|
|
|
|
|
Procedure ExitProcess(val:longint);
|
|
|
|
|
|
begin
|
|
do_syscall(Syscall_nr_exit,val);
|
|
LinuxError:=ErrNo;
|
|
end;
|
|
|
|
Function WaitPid(Pid:longint;Status:pointer;Options:Integer):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:=do_syscall(syscall_nr_WaitPID,PID,longint(Status),options,0);
|
|
LinuxError:=ErrNo;
|
|
end;
|
|
|
|
Function Shell(const Command:String):Longint;
|
|
{
|
|
Executes the shell, and passes it the string Command. (Through /bin/sh -c)
|
|
The current environment is passed to the shell.
|
|
It waits for the shell to exit, and returns its exit status.
|
|
If the Exec call failed exit status 127 is reported.
|
|
}
|
|
var
|
|
p : ppchar;
|
|
temp,pid : longint;
|
|
begin
|
|
pid:=fork;
|
|
if pid=-1 then
|
|
exit; {Linuxerror already set in Fork}
|
|
if pid=0 then
|
|
begin
|
|
{This is the child.}
|
|
p:=CreateShellArgv(command);
|
|
Execve(p^,p,envp);
|
|
exit(127);
|
|
end;
|
|
temp:=0;
|
|
WaitPid(pid,@temp,0);{Linuxerror is set there}
|
|
Shell:=temp;{ Return exit status }
|
|
end;
|
|
|
|
Function Shell(const Command:AnsiString):Longint;
|
|
{
|
|
AnsiString version of Shell
|
|
}
|
|
var
|
|
p : ppchar;
|
|
temp,pid : longint;
|
|
begin
|
|
pid:=fork;
|
|
if pid=-1 then
|
|
exit; {Linuxerror already set in Fork}
|
|
if pid=0 then
|
|
begin
|
|
{This is the child.}
|
|
p:=CreateShellArgv(command);
|
|
Execve(p^,p,envp);
|
|
exit(127);
|
|
end;
|
|
temp:=0;
|
|
WaitPid(pid,@temp,0);{Linuxerror is set there}
|
|
Shell:=temp;{ Return exit status }
|
|
end;
|
|
|
|
|
|
Function GetPriority(Which,Who:longint):longint;
|
|
{
|
|
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;
|
|
end
|
|
else
|
|
begin
|
|
GetPriority:=do_syscall(syscall_nr_GetPriority,which,who);
|
|
LinuxError:=ErrNo;
|
|
end;
|
|
end;
|
|
|
|
Procedure SetPriority(Which,Who,What:longint);
|
|
{
|
|
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.
|
|
}
|
|
begin
|
|
errno:=0;
|
|
if ((which<prio_process) or (which>prio_user)) or ((what<-20) or (what>20)) then
|
|
linuxerror:=Sys_einval { We can save an interrupt here }
|
|
else
|
|
begin
|
|
do_syscall(Syscall_nr_Setpriority,which,who,what);
|
|
LinuxError:=ErrNo;
|
|
end;
|
|
end;
|
|
|
|
|
|
Procedure Nice(N:integer);
|
|
{
|
|
Set process priority. A positive N means a lower priority.
|
|
A negative N decreases priority.
|
|
|
|
Doesn't exist in BSD. Linux emu uses setpriority in a construct as below:
|
|
}
|
|
|
|
begin
|
|
SetPriority(Prio_Process,0,N);
|
|
end;
|
|
|
|
Function GetPid:LongInt;
|
|
{
|
|
Get Process ID.
|
|
}
|
|
|
|
begin
|
|
GetPID:=do_syscall(Syscall_nr_GetPID);
|
|
LinuxError:=errno;
|
|
end;
|
|
|
|
Function GetPPid:LongInt;
|
|
{
|
|
Get Process ID of parent process.
|
|
}
|
|
|
|
|
|
begin
|
|
GetPPid:=do_syscall(Syscall_nr_GetPPid);
|
|
LinuxError:=errno;
|
|
end;
|
|
|
|
Function GetUid:Longint;
|
|
{
|
|
Get User ID.
|
|
}
|
|
|
|
begin
|
|
GetUID:=do_syscall(Syscall_nr_GetUID);
|
|
LinuxError:=ErrNo;
|
|
end;
|
|
|
|
|
|
|
|
Function GetEUid:Longint;
|
|
{
|
|
Get _effective_ User ID.
|
|
}
|
|
|
|
|
|
begin
|
|
GetEUID:=do_syscall(Syscall_nr_GetEUID);
|
|
LinuxError:=ErrNo;
|
|
end;
|
|
|
|
|
|
Function GetGid:Longint;
|
|
{
|
|
Get Group ID.
|
|
}
|
|
|
|
begin
|
|
GetGID:=do_syscall(Syscall_nr_getgid);
|
|
LinuxError:=ErrNo;
|
|
end;
|
|
|
|
|
|
Function GetEGid:Longint;
|
|
{
|
|
Get _effective_ Group ID.
|
|
}
|
|
|
|
begin
|
|
GetEGID:=do_syscall(syscall_nr_getegid);
|
|
LinuxError:=ErrNo;
|
|
end;
|
|
|
|
{******************************************************************************
|
|
Date and Time related calls
|
|
******************************************************************************}
|
|
|
|
Const
|
|
{Date Translation}
|
|
C1970=2440588;
|
|
D0 = 1461;
|
|
D1 = 146097;
|
|
D2 =1721119;
|
|
|
|
Function GregorianToJulian(Year,Month,Day:Longint):LongInt;
|
|
Var
|
|
Century,XYear: LongInt;
|
|
Begin
|
|
If Month<=2 Then
|
|
Begin
|
|
Dec(Year);
|
|
Inc(Month,12);
|
|
End;
|
|
Dec(Month,3);
|
|
Century:=(longint(Year Div 100)*D1) shr 2;
|
|
XYear:=(longint(Year Mod 100)*D0) shr 2;
|
|
GregorianToJulian:=((((Month*153)+2) div 5)+Day)+D2+XYear+Century;
|
|
End;
|
|
|
|
|
|
|
|
Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
|
|
Var
|
|
YYear,XYear,Temp,TempMonth : LongInt;
|
|
Begin
|
|
Temp:=((JulianDN-D2) shl 2)-1;
|
|
JulianDN:=Temp Div D1;
|
|
XYear:=(Temp Mod D1) or 3;
|
|
YYear:=(XYear Div D0);
|
|
Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
|
|
Day:=((Temp Mod 153)+5) Div 5;
|
|
TempMonth:=Temp Div 153;
|
|
If TempMonth>=10 Then
|
|
Begin
|
|
inc(YYear);
|
|
dec(TempMonth,12);
|
|
End;
|
|
inc(TempMonth,3);
|
|
Month := TempMonth;
|
|
Year:=YYear+(JulianDN*100);
|
|
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;
|
|
|
|
begin
|
|
do_syscall(syscall_nr_gettimeofday,longint(@tv),longint(@tz));
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
Function GetTimeOfDay: longint;
|
|
{
|
|
Get the number of seconds since 00:00, January 1 1970, GMT
|
|
the time NOT corrected any way
|
|
}
|
|
begin
|
|
GetTimeOfDay:=Sys_time;
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
|
|
Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
|
|
{
|
|
Transforms Epoch time into local time (hour, minute,seconds)
|
|
}
|
|
Var
|
|
DateNum: LongInt;
|
|
Begin
|
|
inc(Epoch,TZSeconds);
|
|
Datenum:=(Epoch Div 86400) + c1970;
|
|
JulianToGregorian(DateNum,Year,Month,day);
|
|
Epoch:=Epoch Mod 86400;
|
|
Hour:=Epoch Div 3600;
|
|
Epoch:=Epoch Mod 3600;
|
|
Minute:=Epoch Div 60;
|
|
Second:=Epoch Mod 60;
|
|
End;
|
|
|
|
|
|
Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
|
|
{
|
|
Transforms local time (year,month,day,hour,minutes,second) to Epoch time
|
|
(seconds since 00:00, january 1 1970, corrected for local time zone)
|
|
}
|
|
Begin
|
|
LocalToEpoch:=((GregorianToJulian(Year,Month,Day)-c1970)*86400)+
|
|
(LongInt(Hour)*3600)+(Minute*60)+Second-TZSeconds;
|
|
End;
|
|
|
|
|
|
procedure GetTime(var hour,min,sec,msec,usec:word);
|
|
{
|
|
Gets the current time, adjusted to local time
|
|
}
|
|
var
|
|
year,day,month:Word;
|
|
t : timeval;
|
|
begin
|
|
gettimeofday(t);
|
|
EpochToLocal(t.sec,year,month,day,hour,min,sec);
|
|
msec:=t.usec div 1000;
|
|
usec:=t.usec mod 1000;
|
|
end;
|
|
|
|
|
|
procedure GetTime(var hour,min,sec,sec100:word);
|
|
{
|
|
Gets the current time, adjusted to local time
|
|
}
|
|
var
|
|
usec : word;
|
|
begin
|
|
gettime(hour,min,sec,sec100,usec);
|
|
sec100:=sec100 div 10;
|
|
end;
|
|
|
|
|
|
Procedure GetTime(Var Hour,Min,Sec:Word);
|
|
{
|
|
Gets the current time, adjusted to local time
|
|
}
|
|
var
|
|
msec,usec : Word;
|
|
Begin
|
|
gettime(hour,min,sec,msec,usec);
|
|
End;
|
|
|
|
|
|
Procedure GetDate(Var Year,Month,Day:Word);
|
|
{
|
|
Gets the current date, adjusted to local time
|
|
}
|
|
var
|
|
hour,minute,second : word;
|
|
Begin
|
|
EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
|
|
End;
|
|
|
|
|
|
Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
|
|
{
|
|
Gets the current date, adjusted to local time
|
|
}
|
|
Begin
|
|
EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
|
|
End;
|
|
|
|
{ Include timezone handling routines which use /usr/share/timezone info }
|
|
{$i timezone.inc}
|
|
|
|
|
|
{******************************************************************************
|
|
FileSystem calls
|
|
******************************************************************************}
|
|
|
|
Function fdOpen(pathname:string;flags:longint):longint;
|
|
begin
|
|
pathname:=pathname+#0;
|
|
fdOpen:=Sys_Open(@pathname[1],flags,438);
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
|
|
|
|
Function fdOpen(pathname:string;flags,mode:longint):longint;
|
|
begin
|
|
pathname:=pathname+#0;
|
|
fdOpen:=Sys_Open(@pathname[1],flags,mode);
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
|
|
|
|
Function fdOpen(pathname:pchar;flags:longint):longint;
|
|
begin
|
|
fdOpen:=Sys_Open(pathname,flags,0);
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
|
|
|
|
Function fdOpen(pathname:pchar;flags,mode:longint):longint;
|
|
begin
|
|
fdOpen:=Sys_Open(pathname,flags,mode);
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
|
|
|
|
Function fdClose(fd:longint):boolean;
|
|
begin
|
|
fdClose:=(Sys_Close(fd)=0);
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
|
|
|
|
Function fdRead(fd:longint;var buf;size:longint):longint;
|
|
begin
|
|
fdRead:=Sys_Read(fd,pchar(@buf),size);
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
|
|
|
|
Function fdWrite(fd:longint;var buf;size:longint):longint;
|
|
begin
|
|
fdWrite:=Sys_Write(fd,pchar(@buf),size);
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
|
|
|
|
Function fdTruncate(fd,size:longint):boolean;
|
|
|
|
begin
|
|
fdtruncate:=do_syscall(syscall_nr_ftruncate,fd,size,0)=0;
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
Function fdSeek (fd,pos,seektype :longint): longint;
|
|
{
|
|
Do a Seek on a file descriptor fd to position pos, starting from seektype
|
|
|
|
}
|
|
begin
|
|
fdseek:=Sys_LSeek (fd,pos,seektype);
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
Function fdFlush (fd : Longint) : Boolean;
|
|
|
|
begin
|
|
fdflush:=do_syscall(syscall_nr_fsync,fd)=0;
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
function sys_fcntl(Fd:longint;Cmd:longint;Arg:Longint):longint;
|
|
|
|
begin
|
|
sys_fcntl:=do_syscall(syscall_nr_fcntl,fd,cmd,arg);
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
Function Fcntl(Fd:longint;Cmd:longint):longint;
|
|
{
|
|
Read or manipulate a file.(See also fcntl (2) )
|
|
Possible values for Cmd are :
|
|
F_GetFd,F_GetFl,F_GetOwn
|
|
Errors are reported in Linuxerror;
|
|
If Cmd is different from the allowed values, linuxerror=Sys_eninval.
|
|
}
|
|
|
|
begin
|
|
if (cmd in [F_GetFd,F_GetFl,F_GetOwn]) then
|
|
begin
|
|
Linuxerror:=sys_fcntl(fd,cmd,0);
|
|
if linuxerror=-1 then
|
|
begin
|
|
linuxerror:=errno;
|
|
fcntl:=0;
|
|
end
|
|
else
|
|
begin
|
|
fcntl:=linuxerror;
|
|
linuxerror:=0;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
linuxerror:=Sys_einval;
|
|
Fcntl:=0;
|
|
end;
|
|
end;
|
|
|
|
|
|
Procedure Fcntl(Fd:longint;Cmd:longint;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]) then
|
|
begin
|
|
sys_fcntl(fd,cmd,arg);
|
|
LinuxError:=ErrNo;
|
|
end
|
|
else
|
|
linuxerror:=Sys_einval;
|
|
end;
|
|
|
|
|
|
Function Fcntl(var Fd:Text;Cmd:longint):longint;
|
|
begin
|
|
Fcntl := Fcntl(textrec(Fd).handle, Cmd);
|
|
end;
|
|
|
|
Procedure Fcntl(var Fd:Text;Cmd:longint;Arg:Longint);
|
|
begin
|
|
Fcntl(textrec(Fd).handle, Cmd, Arg);
|
|
end;
|
|
|
|
|
|
Function Chmod(path:pathstr;Newmode:longint):Boolean;
|
|
{
|
|
Changes the permissions of a file.
|
|
}
|
|
|
|
begin
|
|
path:=path+#0;
|
|
chmod:=do_syscall(syscall_nr_chmod,longint(@path[1]),newmode)=0;
|
|
LinuxError:=Errno;
|
|
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
|
|
path:=path+#0;
|
|
ChOwn:=do_syscall(syscall_nr_chown,longint(@path[1]),newuid,newgid)=0;
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
Function Utime(path:pathstr;utim:utimebuf):boolean;
|
|
|
|
begin
|
|
UTime:=do_syscall(syscall_nr_utimes,longint(@path[1]),longint(@utim))=0;
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
Function Flock (fd,mode : longint) : boolean;
|
|
|
|
begin
|
|
Flock:=do_syscall(syscall_nr_flock,fd,mode)=0;
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
Function Flock (var T : text;mode : longint) : boolean;
|
|
begin
|
|
Flock:=Flock(TextRec(T).Handle,mode);
|
|
end;
|
|
|
|
Function Flock (var F : File;mode : longint) : boolean;
|
|
begin
|
|
Flock:=Flock(FileRec(F).Handle,mode);
|
|
end;
|
|
|
|
Function FStat(Path:Pathstr;Var Info:stat):Boolean;
|
|
{
|
|
Get all information on a file, and return it in Info.
|
|
}
|
|
|
|
begin
|
|
path:=path+#0;
|
|
FStat:=(Sys_stat(@(path[1]),Info)=0);
|
|
LinuxError:=errno;
|
|
end;
|
|
|
|
Function Fstat(Fd:Longint;var Info:stat):Boolean;
|
|
{
|
|
Get all information on a file descriptor, and return it in info.
|
|
}
|
|
|
|
begin
|
|
FStat:=do_syscall(syscall_nr_fstat,fd,longint(@info))=0;
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
Function FStat(var F:Text;Var Info:stat):Boolean;
|
|
{
|
|
Get all information on a text file, and return it in info.
|
|
}
|
|
begin
|
|
FStat:=Fstat(TextRec(F).Handle,INfo);
|
|
end;
|
|
|
|
Function FStat(var F:File;Var Info:stat):Boolean;
|
|
{
|
|
Get all information on a untyped file, and return it in info.
|
|
}
|
|
begin
|
|
FStat:=Fstat(FileRec(F).Handle,Info);
|
|
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:=Do_syscall(syscall_nr_lstat,longint(@filename[1]),longint(@info))=0;
|
|
LinuxError:=Errno;
|
|
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:=Do_Syscall(syscall_nr_statfs,longint(@path[1]),longint(@info))=0;
|
|
LinuxError:=Errno;
|
|
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:=do_syscall(syscall_nr_fstatfs,fd,longint(@info))=0;
|
|
LinuxError:=Errno;
|
|
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:=Do_Syscall(syscall_nr_link,longint(@oldpath[1]),longint(@newpath[1]))=0;
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
Function SymLink(OldPath,newPath:pathstr):boolean;
|
|
{
|
|
Proceduces a soft link from new to old.
|
|
}
|
|
|
|
begin
|
|
oldpath:=oldpath+#0;
|
|
newpath:=newpath+#0;
|
|
SymLink:=Do_Syscall(syscall_nr_symlink,longint(@oldpath[1]),longint(@newpath[1]))=0;
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
Function UnLink(Path:pathstr):boolean;
|
|
{
|
|
Removes the file in 'Path' (that is, it decreases the link count with one.
|
|
if the link count is zero, the file is removed from the disk.
|
|
}
|
|
begin
|
|
path:=path+#0;
|
|
Unlink:=Sys_unlink(pchar(@(path[1])))=0;
|
|
linuxerror:=errno;
|
|
end;
|
|
|
|
Function UnLink(Path:pchar):Boolean;
|
|
{
|
|
Removes the file in 'Path' (that is, it decreases the link count with one.
|
|
if the link count is zero, the file is removed from the disk.
|
|
}
|
|
begin
|
|
Unlink:=(Sys_unlink(path)=0);
|
|
linuxerror:=errno;
|
|
end;
|
|
|
|
|
|
Function FRename (OldName,NewName : Pchar) : Boolean;
|
|
begin
|
|
FRename:=Sys_rename(OldName,NewName)=0;
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
|
|
Function FRename (OldName,NewName : String) : Boolean;
|
|
begin
|
|
OldName:=OldName+#0;
|
|
NewName:=NewName+#0;
|
|
FRename:=FRename (@OldName[1],@NewName[1]);
|
|
end;
|
|
|
|
{!!}
|
|
Function Umask(Mask:Integer):integer;
|
|
{
|
|
Sets file creation mask to (Mask and 0777 (octal) ), and returns the
|
|
previous value.
|
|
}
|
|
begin
|
|
UMask:=Do_syscall(syscall_nr_umask,mask);
|
|
LinuxError:=0;
|
|
end;
|
|
|
|
Function Access(Path:Pathstr ;mode:longint):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:=do_syscall(syscall_nr_access,mode,longint(@path[1]))=0;
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
Function Dup(oldfile:longint;var newfile:longint):Boolean;
|
|
{
|
|
Copies the filedescriptor oldfile to newfile
|
|
}
|
|
|
|
begin
|
|
newfile:=Do_syscall(syscall_nr_dup,oldfile);
|
|
LinuxError:=Errno;
|
|
Dup:=(LinuxError=0);
|
|
end;
|
|
|
|
Function Dup(var oldfile,newfile:text):Boolean;
|
|
{
|
|
Copies the filedescriptor oldfile to newfile, after flushing the buffer of
|
|
oldfile.
|
|
After which the two textfiles are, in effect, the same, except
|
|
that they don't share the same buffer, and don't share the same
|
|
close_on_exit flag.
|
|
}
|
|
begin
|
|
flush(oldfile);{ We cannot share buffers, so we flush them. }
|
|
textrec(newfile):=textrec(oldfile);
|
|
textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
|
|
Dup:=Dup(textrec(oldfile).handle,textrec(newfile).handle);
|
|
end;
|
|
|
|
|
|
Function Dup(var oldfile,newfile:file):Boolean;
|
|
{
|
|
Copies the filedescriptor oldfile to newfile
|
|
}
|
|
begin
|
|
filerec(newfile):=filerec(oldfile);
|
|
Dup:=Dup(filerec(oldfile).handle,filerec(newfile).handle);
|
|
end;
|
|
|
|
|
|
Function Dup2(oldfile,newfile:longint):Boolean;
|
|
{
|
|
Copies the filedescriptor oldfile to newfile
|
|
}
|
|
|
|
begin
|
|
do_syscall(syscall_nr_dup2,oldfile,newfile);
|
|
LinuxError:=Errno;
|
|
Dup2:=(LinuxError=0);
|
|
end;
|
|
|
|
Function Dup2(var oldfile,newfile:text):Boolean;
|
|
{
|
|
Copies the filedescriptor oldfile to newfile, after flushing the buffer of
|
|
oldfile. It closes newfile if it was still open.
|
|
After which the two textfiles are, in effect, the same, except
|
|
that they don't share the same buffer, and don't share the same
|
|
close_on_exit flag.
|
|
}
|
|
var
|
|
tmphandle : word;
|
|
begin
|
|
case TextRec(oldfile).mode of
|
|
fmOutput, fmInOut, fmAppend :
|
|
flush(oldfile);{ We cannot share buffers, so we flush them. }
|
|
end;
|
|
case TextRec(newfile).mode of
|
|
fmOutput, fmInOut, fmAppend :
|
|
flush(newfile);
|
|
end;
|
|
tmphandle:=textrec(newfile).handle;
|
|
textrec(newfile):=textrec(oldfile);
|
|
textrec(newfile).handle:=tmphandle;
|
|
textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
|
|
Dup2:=Dup2(textrec(oldfile).handle,textrec(newfile).handle);
|
|
end;
|
|
|
|
|
|
Function Dup2(var oldfile,newfile:file):Boolean;
|
|
{
|
|
Copies the filedescriptor oldfile to newfile
|
|
}
|
|
begin
|
|
filerec(newfile):=filerec(oldfile);
|
|
Dup2:=Dup2(filerec(oldfile).handle,filerec(newfile).handle);
|
|
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.
|
|
}
|
|
|
|
begin
|
|
Select:=do_syscall(syscall_nr_select,n,longint(readfds),longint(writefds),longint(exceptfds),longint(timeout));
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
Function Select(N:longint;readfds,writefds
|
|
,exceptfds:PFDSet;TimeOut:Longint):longint;
|
|
{
|
|
Select checks whether the file descriptor sets in readfs/writefs/exceptfs
|
|
have changed.
|
|
This function allows specification of a timeout as a longint.
|
|
}
|
|
var
|
|
p : PTimeVal;
|
|
tv : TimeVal;
|
|
begin
|
|
if TimeOut=-1 then
|
|
p:=nil
|
|
else
|
|
begin
|
|
tv.Sec:=Timeout div 1000;
|
|
tv.Usec:=(Timeout mod 1000)*1000;
|
|
p:=@tv;
|
|
end;
|
|
Select:=Select(N,Readfds,WriteFds,ExceptFds,p);
|
|
end;
|
|
|
|
|
|
|
|
Function SelectText(var T:Text;TimeOut :PTimeval):Longint;
|
|
Var
|
|
F:FDSet;
|
|
begin
|
|
if textrec(t).mode=fmclosed then
|
|
begin
|
|
LinuxError:=Sys_EBADF;
|
|
exit(-1);
|
|
end;
|
|
FD_Zero(f);
|
|
FD_Set(textrec(T).handle,f);
|
|
if textrec(T).mode=fminput then
|
|
SelectText:=select(textrec(T).handle+1,@f,nil,nil,TimeOut)
|
|
else
|
|
SelectText:=select(textrec(T).handle+1,nil,@f,nil,TimeOut);
|
|
end;
|
|
|
|
|
|
{******************************************************************************
|
|
Directory
|
|
******************************************************************************}
|
|
|
|
Function OpenDir(F:String):PDir;
|
|
begin
|
|
F:=F+#0;
|
|
OpenDir:=OpenDir(@F[1]);
|
|
end;
|
|
|
|
|
|
procedure SeekDir(p:pdir;off:longint);
|
|
begin
|
|
if p=nil then
|
|
begin
|
|
errno:=Sys_EBADF;
|
|
exit;
|
|
end;
|
|
p^.nextoff:=Sys_lseek(p^.fd,off,seek_set);
|
|
p^.size:=0;
|
|
p^.loc:=0;
|
|
end;
|
|
|
|
|
|
function TellDir(p:pdir):longint;
|
|
begin
|
|
if p=nil then
|
|
begin
|
|
errno:=Sys_EBADF;
|
|
telldir:=-1;
|
|
exit;
|
|
end;
|
|
telldir:=Sys_lseek(p^.fd,0,seek_cur)
|
|
{ We could try to use the nextoff field here, but on my 1.2.13
|
|
kernel, this gives nothing... This may have to do with
|
|
the readdir implementation of libc... I also didn't find any trace of
|
|
the field in the kernel code itself, So I suspect it is an artifact of libc.
|
|
Michael. }
|
|
end;
|
|
|
|
|
|
|
|
Function ReadDir(P:pdir):pdirent;
|
|
begin
|
|
ReadDir:=Sys_ReadDir(p);
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
|
|
{******************************************************************************
|
|
Pipes/Fifo
|
|
******************************************************************************}
|
|
|
|
Procedure OpenPipe(var F:Text);
|
|
begin
|
|
case textrec(f).mode of
|
|
fmoutput :
|
|
if textrec(f).userdata[1]<>P_OUT then
|
|
textrec(f).mode:=fmclosed;
|
|
fminput :
|
|
if textrec(f).userdata[1]<>P_IN then
|
|
textrec(f).mode:=fmclosed;
|
|
else
|
|
textrec(f).mode:=fmclosed;
|
|
end;
|
|
end;
|
|
|
|
|
|
Procedure IOPipe(var F:text);
|
|
begin
|
|
case textrec(f).mode of
|
|
fmoutput :
|
|
begin
|
|
{ first check if we need something to write, else we may
|
|
get a SigPipe when Close() is called (PFV) }
|
|
if textrec(f).bufpos>0 then
|
|
Sys_write(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufpos);
|
|
end;
|
|
fminput :
|
|
textrec(f).bufend:=Sys_read(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufsize);
|
|
end;
|
|
textrec(f).bufpos:=0;
|
|
end;
|
|
|
|
|
|
Procedure FlushPipe(var F:Text);
|
|
begin
|
|
if (textrec(f).mode=fmoutput) and (textrec(f).bufpos<>0) then
|
|
IOPipe(f);
|
|
textrec(f).bufpos:=0;
|
|
end;
|
|
|
|
|
|
Procedure ClosePipe(var F:text);
|
|
begin
|
|
textrec(f).mode:=fmclosed;
|
|
Sys_close(textrec(f).handle);
|
|
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
|
|
do_syscall(syscall_nr_pipe,longint(@pip));
|
|
LinuxError:=Errno;
|
|
pipe_in:=pip[1];
|
|
pipe_out:=pip[2];
|
|
AssignPipe:=(LinuxError=0);
|
|
end;
|
|
|
|
Function AssignPipe(var pipe_in,pipe_out:text):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
|
|
f_in,f_out : longint;
|
|
begin
|
|
if not AssignPipe(f_in,f_out) then
|
|
begin
|
|
AssignPipe:=false;
|
|
exit;
|
|
end;
|
|
{ Set up input }
|
|
Assign(Pipe_in,'');
|
|
Textrec(Pipe_in).Handle:=f_in;
|
|
Textrec(Pipe_in).Mode:=fmInput;
|
|
Textrec(Pipe_in).userdata[1]:=P_IN;
|
|
TextRec(Pipe_in).OpenFunc:=@OpenPipe;
|
|
TextRec(Pipe_in).InOutFunc:=@IOPipe;
|
|
TextRec(Pipe_in).FlushFunc:=@FlushPipe;
|
|
TextRec(Pipe_in).CloseFunc:=@ClosePipe;
|
|
{ Set up output }
|
|
Assign(Pipe_out,'');
|
|
Textrec(Pipe_out).Handle:=f_out;
|
|
Textrec(Pipe_out).Mode:=fmOutput;
|
|
Textrec(Pipe_out).userdata[1]:=P_OUT;
|
|
TextRec(Pipe_out).OpenFunc:=@OpenPipe;
|
|
TextRec(Pipe_out).InOutFunc:=@IOPipe;
|
|
TextRec(Pipe_out).FlushFunc:=@FlushPipe;
|
|
TextRec(Pipe_out).CloseFunc:=@ClosePipe;
|
|
AssignPipe:=true;
|
|
end;
|
|
|
|
|
|
Function AssignPipe(var pipe_in,pipe_out:file):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
|
|
f_in,f_out : longint;
|
|
begin
|
|
if not AssignPipe(f_in,f_out) then
|
|
begin
|
|
AssignPipe:=false;
|
|
exit;
|
|
end;
|
|
{ Set up input }
|
|
Assign(Pipe_in,'');
|
|
Filerec(Pipe_in).Handle:=f_in;
|
|
Filerec(Pipe_in).Mode:=fmInput;
|
|
Filerec(Pipe_in).recsize:=1;
|
|
Filerec(Pipe_in).userdata[1]:=P_IN;
|
|
{ Set up output }
|
|
Assign(Pipe_out,'');
|
|
Filerec(Pipe_out).Handle:=f_out;
|
|
Filerec(Pipe_out).Mode:=fmoutput;
|
|
Filerec(Pipe_out).recsize:=1;
|
|
Filerec(Pipe_out).userdata[1]:=P_OUT;
|
|
AssignPipe:=true;
|
|
end;
|
|
|
|
|
|
Function PClose(Var F:text) :longint;
|
|
var
|
|
pl : ^longint;
|
|
res : longint;
|
|
|
|
begin
|
|
do_syscall(syscall_nr_close,Textrec(F).Handle);
|
|
{ closed our side, Now wait for the other - this appears to be needed ?? }
|
|
pl:=@(textrec(f).userdata[2]);
|
|
waitpid(pl^,@res,0);
|
|
pclose:=res shr 8;
|
|
end;
|
|
|
|
Function PClose(Var F:file) : longint;
|
|
var
|
|
pl : ^longint;
|
|
res : longint;
|
|
|
|
begin
|
|
do_syscall(syscall_nr_close,filerec(F).Handle);
|
|
{ closed our side, Now wait for the other - this appears to be needed ?? }
|
|
pl:=@(filerec(f).userdata[2]);
|
|
waitpid(pl^,@res,0);
|
|
pclose:=res shr 8;
|
|
end;
|
|
|
|
Procedure PCloseText(Var F:text);
|
|
{
|
|
May not use @PClose due overloading
|
|
}
|
|
begin
|
|
PClose(f);
|
|
end;
|
|
|
|
Procedure POpen(var F:text;const Prog:String;rw:char);
|
|
{
|
|
Starts the program in 'Prog' and makes it's input or out put the
|
|
other end of a pipe. If rw is 'w' or 'W', then whatever is written to
|
|
F, will be read from stdin by the program in 'Prog'. The inverse is true
|
|
for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
|
|
read from 'f'.
|
|
}
|
|
var
|
|
pipi,
|
|
pipo : text;
|
|
pid : longint;
|
|
pl : ^longint;
|
|
pp : ppchar;
|
|
begin
|
|
LinuxError:=0;
|
|
rw:=upcase(rw);
|
|
if not (rw in ['R','W']) then
|
|
begin
|
|
LinuxError:=Sys_enoent;
|
|
exit;
|
|
end;
|
|
AssignPipe(pipi,pipo);
|
|
if Linuxerror<>0 then
|
|
exit;
|
|
pid:=fork;
|
|
if linuxerror<>0 then
|
|
begin
|
|
close(pipi);
|
|
close(pipo);
|
|
exit;
|
|
end;
|
|
if pid=0 then
|
|
begin
|
|
{ We're in the child }
|
|
if rw='W' then
|
|
begin
|
|
close(pipo);
|
|
dup2(pipi,input);
|
|
close(pipi);
|
|
if linuxerror<>0 then
|
|
halt(127);
|
|
end
|
|
else
|
|
begin
|
|
close(pipi);
|
|
dup2(pipo,output);
|
|
close(pipo);
|
|
if linuxerror<>0 then
|
|
halt(127);
|
|
end;
|
|
pp:=createshellargv(prog);
|
|
Execve(pp^,pp,envp);
|
|
halt(127);
|
|
end
|
|
else
|
|
begin
|
|
{ We're in the parent }
|
|
if rw='W' then
|
|
begin
|
|
close(pipi);
|
|
f:=pipo;
|
|
textrec(f).bufptr:=@textrec(f).buffer;
|
|
end
|
|
else
|
|
begin
|
|
close(pipo);
|
|
f:=pipi;
|
|
textrec(f).bufptr:=@textrec(f).buffer;
|
|
end;
|
|
{Save the process ID - needed when closing }
|
|
pl:=@(textrec(f).userdata[2]);
|
|
pl^:=pid;
|
|
textrec(f).closefunc:=@PCloseText;
|
|
end;
|
|
end;
|
|
|
|
|
|
Procedure POpen(var F:file;const Prog:String;rw:char);
|
|
{
|
|
Starts the program in 'Prog' and makes it's input or out put the
|
|
other end of a pipe. If rw is 'w' or 'W', then whatever is written to
|
|
F, will be read from stdin by the program in 'Prog'. The inverse is true
|
|
for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
|
|
read from 'f'.
|
|
}
|
|
var
|
|
pipi,
|
|
pipo : file;
|
|
pid : longint;
|
|
pl : ^longint;
|
|
p,pp : ppchar;
|
|
temp : string[255];
|
|
begin
|
|
LinuxError:=0;
|
|
rw:=upcase(rw);
|
|
if not (rw in ['R','W']) then
|
|
begin
|
|
LinuxError:=Sys_enoent;
|
|
exit;
|
|
end;
|
|
AssignPipe(pipi,pipo);
|
|
if Linuxerror<>0 then
|
|
exit;
|
|
pid:=fork;
|
|
if linuxerror<>0 then
|
|
begin
|
|
close(pipi);
|
|
close(pipo);
|
|
exit;
|
|
end;
|
|
if pid=0 then
|
|
begin
|
|
{ We're in the child }
|
|
if rw='W' then
|
|
begin
|
|
close(pipo);
|
|
dup2(filerec(pipi).handle,stdinputhandle);
|
|
close(pipi);
|
|
if linuxerror<>0 then
|
|
halt(127);
|
|
end
|
|
else
|
|
begin
|
|
close(pipi);
|
|
dup2(filerec(pipo).handle,stdoutputhandle);
|
|
close(pipo);
|
|
if linuxerror<>0 then
|
|
halt(127);
|
|
end;
|
|
getmem(pp,sizeof(pchar)*4);
|
|
temp:='/bin/sh'#0'-c'#0+prog+#0;
|
|
p:=pp;
|
|
p^:=@temp[1];
|
|
inc(p);
|
|
p^:=@temp[9];
|
|
inc(p);
|
|
p^:=@temp[12];
|
|
inc(p);
|
|
p^:=Nil;
|
|
Execve('/bin/sh',pp,envp);
|
|
halt(127);
|
|
end
|
|
else
|
|
begin
|
|
{ We're in the parent }
|
|
if rw='W' then
|
|
begin
|
|
close(pipi);
|
|
f:=pipo;
|
|
end
|
|
else
|
|
begin
|
|
close(pipo);
|
|
f:=pipi;
|
|
end;
|
|
{Save the process ID - needed when closing }
|
|
pl:=@(filerec(f).userdata[2]);
|
|
pl^:=pid;
|
|
end;
|
|
end;
|
|
|
|
|
|
Function mkFifo(pathname:string;mode:longint):boolean;
|
|
|
|
begin
|
|
pathname:=pathname+#0;
|
|
mkfifo:=do_syscall(syscall_nr_mknod,longint(@pathname[1]),mode or STAT_IFIFO,0)=0;
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
Procedure AssignStream(Var StreamIn,Streamout:text;Const Prog:String);
|
|
{
|
|
Starts the program in 'Prog' and makes its input and output the
|
|
other end of two pipes, which are the stdin and stdout of a program
|
|
specified in 'Prog'.
|
|
streamout can be used to write to the program, streamin can be used to read
|
|
the output of the program. See the following diagram :
|
|
Parent Child
|
|
STreamout --> Input
|
|
Streamin <-- Output
|
|
}
|
|
var
|
|
pipi,
|
|
pipo : text;
|
|
pid : longint;
|
|
pl : ^Longint;
|
|
begin
|
|
LinuxError:=0;
|
|
AssignPipe(streamin,pipo);
|
|
if Linuxerror<>0 then
|
|
exit;
|
|
AssignPipe(pipi,streamout);
|
|
if Linuxerror<>0 then
|
|
exit;
|
|
pid:=fork;
|
|
if linuxerror<>0 then
|
|
begin
|
|
close(pipi);
|
|
close(pipo);
|
|
close (streamin);
|
|
close (streamout);
|
|
exit;
|
|
end;
|
|
if pid=0 then
|
|
begin
|
|
{ We're in the child }
|
|
{ Close what we don't need }
|
|
close(streamout);
|
|
close(streamin);
|
|
dup2(pipi,input);
|
|
if linuxerror<>0 then
|
|
halt(127);
|
|
close(pipi);
|
|
dup2(pipo,output);
|
|
if linuxerror<>0 then
|
|
halt (127);
|
|
close(pipo);
|
|
Execl(Prog);
|
|
halt(127);
|
|
end
|
|
else
|
|
begin
|
|
{ we're in the parent}
|
|
close(pipo);
|
|
close(pipi);
|
|
{Save the process ID - needed when closing }
|
|
pl:=@(textrec(StreamIn).userdata[2]);
|
|
pl^:=pid;
|
|
textrec(StreamIn).closefunc:=@PCloseText;
|
|
{Save the process ID - needed when closing }
|
|
pl:=@(textrec(StreamOut).userdata[2]);
|
|
pl^:=pid;
|
|
textrec(StreamOut).closefunc:=@PCloseText;
|
|
end;
|
|
end;
|
|
|
|
|
|
function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: String): LongInt;
|
|
{
|
|
Starts the program in 'prog' and makes its input, output and error output the
|
|
other end of three pipes, which are the stdin, stdout and stderr of a program
|
|
specified in 'prog'.
|
|
StreamOut can be used to write to the program, StreamIn can be used to read
|
|
the output of the program, StreamErr reads the error output of the program.
|
|
See the following diagram :
|
|
Parent Child
|
|
StreamOut --> StdIn (input)
|
|
StreamIn <-- StdOut (output)
|
|
StreamErr <-- StdErr (error output)
|
|
}
|
|
var
|
|
PipeIn, PipeOut, PipeErr: text;
|
|
pid: LongInt;
|
|
pl: ^LongInt;
|
|
begin
|
|
LinuxError := 0;
|
|
AssignStream := -1;
|
|
|
|
// Assign pipes
|
|
AssignPipe(StreamIn, PipeOut);
|
|
if LinuxError <> 0 then exit;
|
|
|
|
AssignPipe(StreamErr, PipeErr);
|
|
if LinuxError <> 0 then begin
|
|
Close(StreamIn);
|
|
Close(PipeOut);
|
|
exit;
|
|
end;
|
|
|
|
AssignPipe(PipeIn, StreamOut);
|
|
if LinuxError <> 0 then begin
|
|
Close(StreamIn);
|
|
Close(PipeOut);
|
|
Close(StreamErr);
|
|
Close(PipeErr);
|
|
exit;
|
|
end;
|
|
|
|
// Fork
|
|
|
|
pid := Fork;
|
|
if LinuxError <> 0 then begin
|
|
Close(StreamIn);
|
|
Close(PipeOut);
|
|
Close(StreamErr);
|
|
Close(PipeErr);
|
|
Close(PipeIn);
|
|
Close(StreamOut);
|
|
exit;
|
|
end;
|
|
|
|
if pid = 0 then begin
|
|
// *** We are in the child ***
|
|
// Close what we don not need
|
|
Close(StreamOut);
|
|
Close(StreamIn);
|
|
Close(StreamErr);
|
|
// Connect pipes
|
|
dup2(PipeIn, Input);
|
|
if LinuxError <> 0 then Halt(127);
|
|
Close(PipeIn);
|
|
dup2(PipeOut, Output);
|
|
if LinuxError <> 0 then Halt(127);
|
|
Close(PipeOut);
|
|
dup2(PipeErr, StdErr);
|
|
if LinuxError <> 0 then Halt(127);
|
|
Close(PipeErr);
|
|
// Execute program
|
|
Execl(Prog);
|
|
Halt(127);
|
|
end else begin
|
|
// *** We are in the parent ***
|
|
Close(PipeErr);
|
|
Close(PipeOut);
|
|
Close(PipeIn);
|
|
// Save the process ID - needed when closing
|
|
pl := @(TextRec(StreamIn).userdata[2]);
|
|
pl^ := pid;
|
|
TextRec(StreamIn).closefunc := @PCloseText;
|
|
// Save the process ID - needed when closing
|
|
pl := @(TextRec(StreamOut).userdata[2]);
|
|
pl^ := pid;
|
|
TextRec(StreamOut).closefunc := @PCloseText;
|
|
// Save the process ID - needed when closing
|
|
pl := @(TextRec(StreamErr).userdata[2]);
|
|
pl^ := pid;
|
|
TextRec(StreamErr).closefunc := @PCloseText;
|
|
AssignStream := pid;
|
|
end;
|
|
end;
|
|
|
|
|
|
{******************************************************************************
|
|
General information calls
|
|
******************************************************************************}
|
|
|
|
{
|
|
Function Sysinfo(var Info:TSysinfo):Boolean;
|
|
{
|
|
Get system info
|
|
}
|
|
var
|
|
regs : SysCallregs;
|
|
Begin
|
|
regs.reg2:=longint(@info);
|
|
Sysinfo:=SysCall(SysCall_nr_Sysinfo,regs)=0;
|
|
End;
|
|
}
|
|
|
|
{
|
|
Function Uname(var unamerec:utsname):Boolean;
|
|
{
|
|
Get machine's names
|
|
}
|
|
var
|
|
regs : SysCallregs;
|
|
Begin
|
|
regs.reg2:=longint(@unamerec);
|
|
Uname:=SysCall(SysCall_nr_uname,regs)=0;
|
|
LinuxError:=Errno;
|
|
End;
|
|
}
|
|
|
|
|
|
Function GetEnv(P:string):Pchar;
|
|
{
|
|
Searches the environment for a string with name p and
|
|
returns a pchar to it's value.
|
|
A pchar is used to accomodate for strings of length > 255
|
|
}
|
|
var
|
|
ep : ppchar;
|
|
found : boolean;
|
|
Begin
|
|
p:=p+'='; {Else HOST will also find HOSTNAME, etc}
|
|
ep:=envp;
|
|
found:=false;
|
|
if ep<>nil then
|
|
begin
|
|
while (not found) and (ep^<>nil) do
|
|
begin
|
|
if strlcomp(@p[1],(ep^),length(p))=0 then
|
|
found:=true
|
|
else
|
|
inc(ep);
|
|
end;
|
|
end;
|
|
if found then
|
|
getenv:=ep^+length(p)
|
|
else
|
|
getenv:=nil;
|
|
end;
|
|
|
|
{
|
|
|
|
Function GetDomainName:String;
|
|
{
|
|
Get machines domain name. Returns empty string if not set.
|
|
}
|
|
Var
|
|
Sysn : utsname;
|
|
begin
|
|
Uname(Sysn);
|
|
linuxerror:=errno;
|
|
If linuxerror<>0 then
|
|
getdomainname:=''
|
|
else
|
|
getdomainname:=strpas(@Sysn.domainname[0]);
|
|
end;
|
|
|
|
Function GetHostName:String;
|
|
{
|
|
Get machines name. Returns empty string if not set.
|
|
}
|
|
|
|
Var
|
|
Sysn : utsname;
|
|
begin
|
|
uname(Sysn);
|
|
linuxerror:=errno;
|
|
If linuxerror<>0 then
|
|
gethostname:=''
|
|
else
|
|
gethostname:=strpas(@Sysn.nodename[0]);
|
|
end;
|
|
}
|
|
|
|
{******************************************************************************
|
|
Signal handling calls
|
|
******************************************************************************}
|
|
|
|
Function Kill(Pid:longint;Sig:integer):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:=do_syscall(syscall_nr_kill,pid,sig);
|
|
if kill<0 THEN
|
|
Kill:=0;
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
Procedure SigAction(Signum:Integer;Var Act,OldAct:PSigActionRec );
|
|
{
|
|
Change action of process upon receipt of a signal.
|
|
Signum specifies the signal (all except SigKill and SigStop).
|
|
If Act is non-nil, it is used to specify the new action.
|
|
If OldAct is non-nil the previous action is saved there.
|
|
}
|
|
|
|
begin
|
|
do_syscall(syscall_nr_sigaction,longint(signum),longint(act),longint(oldact));
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
Procedure SigProcMask(How:Integer;SSet,OldSSet:PSigSet);
|
|
{
|
|
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
|
|
do_syscall(syscall_nr_sigprocmask,longint(how),longint(sset),longint(oldsset));
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
Function SigPending:SigSet;
|
|
{
|
|
Allows examination of pending signals. The signal mask of pending
|
|
signals is set in SSet
|
|
}
|
|
Var
|
|
dummy : Sigset;
|
|
begin
|
|
do_syscall(syscall_nr_sigpending,longint(@dummy));
|
|
LinuxError:=Errno;
|
|
sigpending:=dummy;
|
|
end;
|
|
|
|
Procedure SigSuspend(Mask:Sigset);
|
|
{
|
|
Set the signal mask with Mask, and suspend the program until a signal
|
|
is received.
|
|
}
|
|
|
|
begin
|
|
do_syscall(syscall_nr_sigsuspend,mask);
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
{
|
|
Function Signal(Signum:Integer;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.
|
|
}
|
|
|
|
begin
|
|
sr.reg2:=signum;
|
|
sr.reg3:=longint(handler);
|
|
Linuxerror:=SysCall(Syscall_nr_signal,sr);
|
|
If linuxerror=Sig_Err then
|
|
begin
|
|
Signal:=nil;
|
|
Linuxerror:=errno;
|
|
end
|
|
else
|
|
begin
|
|
Signal:=signalhandler(Linuxerror);
|
|
linuxerror:=0;
|
|
end;
|
|
end;
|
|
}
|
|
|
|
procedure SigRaise(sig:integer);
|
|
begin
|
|
Kill(GetPid,Sig);
|
|
end;
|
|
|
|
{
|
|
Function Alarm(Sec : Longint) : longint;
|
|
|
|
Var Sr : Syscallregs;
|
|
|
|
begin
|
|
sr.reg2:=Sec;
|
|
Alarm:=Syscall(syscall_nr_alarm,sr);
|
|
end;
|
|
|
|
Procedure Pause;
|
|
|
|
Var Sr : Syscallregs;
|
|
|
|
begin
|
|
syscall(syscall_nr_pause,sr);
|
|
end;
|
|
}
|
|
{******************************************************************************
|
|
IOCtl and Termios calls
|
|
******************************************************************************}
|
|
|
|
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:=Do_Syscall(syscall_nr_ioctl,handle,ndx,longint(data))=0;
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
|
|
|
|
Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
|
|
begin
|
|
TCGetAttr:=IOCtl(fd,TCGETS,@tios);
|
|
end;
|
|
|
|
|
|
|
|
Function TCSetAttr(fd:longint;OptAct:longint;var tios:TermIOS):boolean;
|
|
var
|
|
nr:longint;
|
|
begin
|
|
case OptAct of
|
|
TCSANOW : nr:=TCSETS;
|
|
TCSADRAIN : nr:=TCSETSW;
|
|
TCSAFLUSH : nr:=TCSETSF;
|
|
else
|
|
begin
|
|
ErrNo:=Sys_EINVAL;
|
|
TCSetAttr:=false;
|
|
exit;
|
|
end;
|
|
end;
|
|
TCSetAttr:=IOCtl(fd,nr,@Tios);
|
|
end;
|
|
|
|
|
|
|
|
Procedure CFSetISpeed(var tios:TermIOS;speed:Longint);
|
|
begin
|
|
tios.c_cflag:=(tios.c_cflag and (not CBAUD)) or speed;
|
|
end;
|
|
|
|
|
|
|
|
Procedure CFSetOSpeed(var tios:TermIOS;speed:Longint);
|
|
begin
|
|
CFSetISpeed(tios,speed);
|
|
end;
|
|
|
|
|
|
|
|
Procedure CFMakeRaw(var tios:TermIOS);
|
|
begin
|
|
with tios do
|
|
begin
|
|
c_iflag:=c_iflag and (not (IGNBRK or BRKINT or PARMRK or ISTRIP or
|
|
INLCR or IGNCR or ICRNL or IXON));
|
|
c_oflag:=c_oflag and (not OPOST);
|
|
c_lflag:=c_lflag and (not (ECHO or ECHONL or ICANON or ISIG or IEXTEN));
|
|
c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or CS8;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
Function TCSendBreak(fd,duration:longint):boolean;
|
|
begin
|
|
TCSendBreak:=IOCtl(fd,TCSBRK,pointer(duration));
|
|
end;
|
|
|
|
|
|
|
|
Function TCSetPGrp(fd,id:longint):boolean;
|
|
begin
|
|
TCSetPGrp:=IOCtl(fd,TIOCSPGRP,pointer(id));
|
|
end;
|
|
|
|
|
|
|
|
Function TCGetPGrp(fd:longint;var id:longint):boolean;
|
|
begin
|
|
TCGetPGrp:=IOCtl(fd,TIOCGPGRP,@id);
|
|
end;
|
|
|
|
|
|
|
|
Function TCDrain(fd:longint):boolean;
|
|
begin
|
|
TCDrain:=IOCtl(fd,TCSBRK,pointer(1));
|
|
end;
|
|
|
|
|
|
|
|
Function TCFlow(fd,act:longint):boolean;
|
|
begin
|
|
TCFlow:=IOCtl(fd,TCXONC,pointer(act));
|
|
end;
|
|
|
|
|
|
|
|
Function TCFlush(fd,qsel:longint):boolean;
|
|
begin
|
|
TCFlush:=IOCtl(fd,TCFLSH,pointer(qsel));
|
|
end;
|
|
|
|
|
|
|
|
Function IsATTY(Handle:Longint):Boolean;
|
|
{
|
|
Check if the filehandle described by 'handle' is a TTY (Terminal)
|
|
}
|
|
var
|
|
t : Termios;
|
|
begin
|
|
IsAtty:=TCGetAttr(Handle,t);
|
|
end;
|
|
|
|
|
|
|
|
Function IsATTY(f: text):Boolean;
|
|
{
|
|
Idem as previous, only now for text variables.
|
|
}
|
|
begin
|
|
IsATTY:=IsaTTY(textrec(f).handle);
|
|
end;
|
|
|
|
|
|
|
|
function TTYName(Handle:Longint):string;
|
|
{
|
|
Return the name of the current tty described by handle f.
|
|
returns empty string in case of an error.
|
|
}
|
|
Const
|
|
dev='/dev';
|
|
var
|
|
name : string;
|
|
st : stat;
|
|
mydev,
|
|
myino : longint;
|
|
dirstream : pdir;
|
|
d : pdirent;
|
|
begin
|
|
TTYName:='';
|
|
fstat(handle,st);
|
|
if (errno<>0) and isatty (handle) then
|
|
exit;
|
|
mydev:=st.dev;
|
|
myino:=st.ino;
|
|
dirstream:=opendir(dev);
|
|
if (linuxerror<>0) then
|
|
exit;
|
|
d:=Readdir(dirstream);
|
|
while (d<>nil) do
|
|
begin
|
|
if (d^.ino=myino) then
|
|
begin
|
|
name:=dev+'/'+strpas(@(d^.name));
|
|
fstat(name,st);
|
|
if (linuxerror=0) and (st.dev=mydev) then
|
|
begin
|
|
closedir(dirstream);
|
|
ttyname:=name;
|
|
exit;
|
|
end;
|
|
end;
|
|
d:=Readdir(dirstream);
|
|
end;
|
|
closedir(dirstream);
|
|
end;
|
|
|
|
|
|
|
|
function TTYName(var F:Text):string;
|
|
{
|
|
Idem as previous, only now for text variables;
|
|
}
|
|
begin
|
|
TTYName:=TTYName(textrec(f).handle);
|
|
end;
|
|
|
|
|
|
|
|
{******************************************************************************
|
|
Utility calls
|
|
******************************************************************************}
|
|
|
|
Function Octal(l:longint):longint;
|
|
{
|
|
Convert an octal specified number to decimal;
|
|
}
|
|
var
|
|
octnr,
|
|
oct : longint;
|
|
begin
|
|
octnr:=0;
|
|
oct:=0;
|
|
while (l>0) do
|
|
begin
|
|
oct:=oct or ((l mod 10) shl octnr);
|
|
l:=l div 10;
|
|
inc(octnr,3);
|
|
end;
|
|
Octal:=oct;
|
|
end;
|
|
|
|
|
|
|
|
Function StringToPPChar(Var S:STring):ppchar;
|
|
{
|
|
Create a PPChar to structure of pchars which are the arguments specified
|
|
in the string S. Especially usefull for creating an ArgV for Exec-calls
|
|
}
|
|
var
|
|
nr : longint;
|
|
Buf : ^char;
|
|
p : ppchar;
|
|
begin
|
|
s:=s+#0;
|
|
buf:=@s[1];
|
|
nr:=0;
|
|
while(buf^<>#0) do
|
|
begin
|
|
while (buf^ in [' ',#8,#10]) do
|
|
inc(buf);
|
|
inc(nr);
|
|
while not (buf^ in [' ',#0,#8,#10]) do
|
|
inc(buf);
|
|
end;
|
|
getmem(p,nr*4);
|
|
StringToPPChar:=p;
|
|
if p=nil then
|
|
begin
|
|
LinuxError:=sys_enomem;
|
|
exit;
|
|
end;
|
|
buf:=@s[1];
|
|
while (buf^<>#0) do
|
|
begin
|
|
while (buf^ in [' ',#8,#10]) do
|
|
begin
|
|
buf^:=#0;
|
|
inc(buf);
|
|
end;
|
|
p^:=buf;
|
|
inc(p);
|
|
p^:=nil;
|
|
while not (buf^ in [' ',#0,#8,#10]) do
|
|
inc(buf);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
Function FExpand(Const Path:PathStr):PathStr;
|
|
var
|
|
temp : pathstr;
|
|
i,j : longint;
|
|
p : pchar;
|
|
Begin
|
|
{Remove eventual drive - doesn't exist in Linux}
|
|
if path[2]=':' then
|
|
i:=3
|
|
else
|
|
i:=1;
|
|
temp:='';
|
|
{Replace ~/ with $HOME}
|
|
if (path[i]='~') and ((i+1>length(path)) or (path[i+1]='/')) then
|
|
begin
|
|
p:=getenv('HOME');
|
|
if not (p=nil) then
|
|
Insert(StrPas(p),temp,i);
|
|
i:=1;
|
|
temp:=temp+Copy(Path,2,255);
|
|
end;
|
|
{Do we have an absolute path ? No - prefix the current dir}
|
|
if temp='' then
|
|
begin
|
|
if path[i]<>'/' then
|
|
begin
|
|
{$I-}
|
|
getdir(0,temp);
|
|
{$I+}
|
|
if ioresult<>0 then;
|
|
end
|
|
else
|
|
inc(i);
|
|
temp:=temp+'/'+copy(path,i,length(path)-i+1)+'/';
|
|
end;
|
|
{First remove all references to '/./'}
|
|
while pos('/./',temp)<>0 do
|
|
delete(temp,pos('/./',temp),2);
|
|
{Now remove also all references to '/../' + of course previous dirs..}
|
|
repeat
|
|
i:=pos('/../',temp);
|
|
{Find the pos of the previous dir}
|
|
if i>1 then
|
|
begin
|
|
j:=i-1;
|
|
while (j>1) and (temp[j]<>'/') do
|
|
dec (j);{temp[1] is always '/'}
|
|
delete(temp,j,i-j+3);
|
|
end
|
|
else
|
|
if i=1 then {i=1, so we have temp='/../something', just delete '/../'}
|
|
delete(temp,1,3);
|
|
until i=0;
|
|
{ Remove ending /.. }
|
|
i:=pos('/..',temp);
|
|
if (i<>0) and (i =length(temp)-2) then
|
|
begin
|
|
j:=i-1;
|
|
while (j>1) and (temp[j]<>'/') do
|
|
dec (j);
|
|
delete (temp,j,i-j+3);
|
|
end;
|
|
{ if last character is / then remove it - dir is also a file :-) }
|
|
if (length(temp)>0) and (temp[length(temp)]='/') then
|
|
dec(byte(temp[0]));
|
|
fexpand:=temp;
|
|
End;
|
|
|
|
|
|
|
|
Function FSearch(const path:pathstr;dirlist:string):pathstr;
|
|
{
|
|
Searches for a file 'path' in the list of direcories in 'dirlist'.
|
|
returns an empty string if not found. Wildcards are NOT allowed.
|
|
If dirlist is empty, it is set to '.'
|
|
}
|
|
Var
|
|
NewDir : PathStr;
|
|
p1 : Longint;
|
|
Info : Stat;
|
|
Begin
|
|
{Replace ':' with ';'}
|
|
for p1:=1to length(dirlist) do
|
|
if dirlist[p1]=':' then
|
|
dirlist[p1]:=';';
|
|
{Check for WildCards}
|
|
If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
|
|
FSearch:='' {No wildcards allowed in these things.}
|
|
Else
|
|
Begin
|
|
Dirlist:='.;'+dirlist;{Make sure current dir is first to be searched.}
|
|
Repeat
|
|
p1:=Pos(';',DirList);
|
|
If p1=0 Then
|
|
p1:=255;
|
|
NewDir:=Copy(DirList,1,P1 - 1);
|
|
if NewDir[Length(NewDir)]<>'/' then
|
|
NewDir:=NewDir+'/';
|
|
NewDir:=NewDir+Path;
|
|
Delete(DirList,1,p1);
|
|
if FStat(NewDir,Info) then
|
|
Begin
|
|
If Pos('./',NewDir)=1 Then
|
|
Delete(NewDir,1,2);
|
|
{DOS strips off an initial .\}
|
|
End
|
|
Else
|
|
NewDir:='';
|
|
Until (DirList='') or (Length(NewDir) > 0);
|
|
FSearch:=NewDir;
|
|
End;
|
|
End;
|
|
|
|
|
|
|
|
Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
|
|
Var
|
|
DotPos,SlashPos,i : longint;
|
|
Begin
|
|
SlashPos:=0;
|
|
DotPos:=256;
|
|
i:=Length(Path);
|
|
While (i>0) and (SlashPos=0) Do
|
|
Begin
|
|
If (DotPos=256) and (Path[i]='.') Then
|
|
DotPos:=i;
|
|
If (Path[i]='/') Then
|
|
SlashPos:=i;
|
|
Dec(i);
|
|
End;
|
|
Ext:=Copy(Path,DotPos,255);
|
|
Dir:=Copy(Path,1,SlashPos);
|
|
Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
|
|
End;
|
|
|
|
|
|
|
|
Function Dirname(Const path:pathstr):pathstr;
|
|
{
|
|
This function returns the directory part of a complete path.
|
|
Unless the directory is root '/', The last character is not
|
|
a slash.
|
|
}
|
|
var
|
|
Dir : PathStr;
|
|
Name : NameStr;
|
|
Ext : ExtStr;
|
|
begin
|
|
FSplit(Path,Dir,Name,Ext);
|
|
if length(Dir)>1 then
|
|
Delete(Dir,length(Dir),1);
|
|
DirName:=Dir;
|
|
end;
|
|
|
|
|
|
|
|
Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
|
|
{
|
|
This function returns the filename part of a complete path. If suf is
|
|
supplied, it is cut off the filename.
|
|
}
|
|
var
|
|
Dir : PathStr;
|
|
Name : NameStr;
|
|
Ext : ExtStr;
|
|
begin
|
|
FSplit(Path,Dir,Name,Ext);
|
|
if Suf<>Ext then
|
|
Name:=Name+Ext;
|
|
BaseName:=Name;
|
|
end;
|
|
|
|
|
|
|
|
Function FNMatch(const Pattern,Name:string):Boolean;
|
|
Var
|
|
LenPat,LenName : longint;
|
|
|
|
Function DoFNMatch(i,j:longint):Boolean;
|
|
Var
|
|
Found : boolean;
|
|
Begin
|
|
Found:=true;
|
|
While Found and (i<=LenPat) Do
|
|
Begin
|
|
Case Pattern[i] of
|
|
'?' : Found:=(j<=LenName);
|
|
'*' : Begin
|
|
{find the next character in pattern, different of ? and *}
|
|
while Found and (i<LenPat) do
|
|
begin
|
|
inc(i);
|
|
case Pattern[i] of
|
|
'*' : ;
|
|
'?' : begin
|
|
inc(j);
|
|
Found:=(j<=LenName);
|
|
end;
|
|
else
|
|
Found:=false;
|
|
end;
|
|
end;
|
|
{Now, find in name the character which i points to, if the * or ?
|
|
wasn't the last character in the pattern, else, use up all the
|
|
chars in name}
|
|
Found:=true;
|
|
if (i<=LenPat) then
|
|
begin
|
|
repeat
|
|
{find a letter (not only first !) which maches pattern[i]}
|
|
while (j<=LenName) and (name[j]<>pattern[i]) do
|
|
inc (j);
|
|
if (j<LenName) then
|
|
begin
|
|
if DoFnMatch(i+1,j+1) then
|
|
begin
|
|
i:=LenPat;
|
|
j:=LenName;{we can stop}
|
|
Found:=true;
|
|
end
|
|
else
|
|
inc(j);{We didn't find one, need to look further}
|
|
end;
|
|
until (j>=LenName);
|
|
end
|
|
else
|
|
j:=LenName;{we can stop}
|
|
end;
|
|
else {not a wildcard character in pattern}
|
|
Found:=(j<=LenName) and (pattern[i]=name[j]);
|
|
end;
|
|
inc(i);
|
|
inc(j);
|
|
end;
|
|
DoFnMatch:=Found and (j>LenName);
|
|
end;
|
|
|
|
Begin {start FNMatch}
|
|
LenPat:=Length(Pattern);
|
|
LenName:=Length(Name);
|
|
FNMatch:=DoFNMatch(1,1);
|
|
End;
|
|
|
|
|
|
|
|
Procedure Globfree(var p : pglob);
|
|
{
|
|
Release memory occupied by pglob structure, and names in it.
|
|
sets p to nil.
|
|
}
|
|
var
|
|
temp : pglob;
|
|
begin
|
|
while p<>nil do
|
|
begin
|
|
temp:=p^.next;
|
|
if p^.name<>nil then
|
|
freemem(p^.name,strlen(p^.name)+1);
|
|
dispose(p);
|
|
p:=temp;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
Function Glob(Const path:pathstr):pglob;
|
|
{
|
|
Fills a tglob structure with entries matching path,
|
|
and returns a pointer to it. Returns nil on error,
|
|
linuxerror is set accordingly.
|
|
}
|
|
var
|
|
temp : string[255];
|
|
thedir : pdir;
|
|
buffer : pdirent;
|
|
root,run : pglob;
|
|
begin
|
|
{ Get directory }
|
|
if dirname(path)='' then
|
|
temp:='.'
|
|
else
|
|
temp:=dirname(path);
|
|
temp:=temp+#0;
|
|
thedir:=opendir(@temp[1]);
|
|
if thedir=nil then
|
|
begin
|
|
glob:=nil;
|
|
linuxerror:=errno;
|
|
exit;
|
|
end;
|
|
temp:=basename(path,'');{ get the pattern }
|
|
if thedir^.fd<0 then
|
|
begin
|
|
linuxerror:=errno;
|
|
glob:=nil;
|
|
exit;
|
|
end;
|
|
{get the entries}
|
|
new(root);
|
|
root^.next:=nil;
|
|
root^.name:=nil;
|
|
run:=root;
|
|
repeat
|
|
buffer:=Sys_readdir(thedir);
|
|
if buffer<>nil then
|
|
begin
|
|
if fnmatch(temp,strpas(@(buffer^.name[0]))) then
|
|
begin
|
|
{ get memory for pglob }
|
|
new(run^.next);
|
|
if run^.next=nil then
|
|
begin
|
|
linuxerror:=Sys_ENOMEM;
|
|
globfree(root);
|
|
glob:=nil;
|
|
exit;
|
|
end
|
|
else
|
|
begin
|
|
run:=run^.next;
|
|
run^.next:=nil;
|
|
end;
|
|
{ Get memory for name }
|
|
getmem(run^.name,strlen(@(buffer^.name[0]))+1);
|
|
if run^.name=nil then
|
|
begin
|
|
linuxerror:=Sys_ENOMEM;
|
|
globfree(root);
|
|
glob:=nil;
|
|
exit;
|
|
end;
|
|
move(buffer^.name[0],run^.name^,strlen(@(buffer^.name[0]))+1);
|
|
end;{ if fnmatch }
|
|
end { buffer <> nil }
|
|
else
|
|
begin
|
|
run:=root;
|
|
if root^.next<>nil then
|
|
root:=root^.next;{ put root on first entry}
|
|
if run<>nil then
|
|
begin
|
|
run^.next:=nil;
|
|
globfree(run);
|
|
end;
|
|
end;
|
|
until buffer=nil;
|
|
if root^.name=nil then
|
|
begin
|
|
dispose(root);
|
|
linuxerror:=0;
|
|
glob:=nil;
|
|
end
|
|
else
|
|
glob:=root;
|
|
end;
|
|
|
|
|
|
{--------------------------------
|
|
FiledescriptorSets
|
|
--------------------------------}
|
|
|
|
Procedure FD_Zero(var fds:fdSet);
|
|
{
|
|
Clear the set of filedescriptors
|
|
}
|
|
begin
|
|
FillChar(fds,sizeof(fdSet),0);
|
|
end;
|
|
|
|
Procedure FD_Clr(fd:longint;var fds:fdSet);
|
|
{
|
|
Remove fd from the set of filedescriptors
|
|
}
|
|
begin
|
|
fds[fd shr 5]:=fds[fd shr 5] and (not (1 shl (fd and 31)));
|
|
end;
|
|
|
|
|
|
|
|
Procedure FD_Set(fd:longint;var fds:fdSet);
|
|
{
|
|
Add fd to the set of filedescriptors
|
|
}
|
|
begin
|
|
fds[fd shr 5]:=fds[fd shr 5] or (1 shl (fd and 31));
|
|
end;
|
|
|
|
|
|
|
|
Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
|
|
{
|
|
Test if fd is part of the set of filedescriptors
|
|
}
|
|
begin
|
|
FD_IsSet:=((fds[fd shr 5] and (1 shl (fd and 31)))<>0);
|
|
end;
|
|
|
|
|
|
|
|
Function GetFS (var T:Text):longint;
|
|
{
|
|
Get File Descriptor of a text file.
|
|
}
|
|
begin
|
|
if textrec(t).mode=fmclosed then
|
|
exit(-1)
|
|
else
|
|
GETFS:=textrec(t).Handle
|
|
end;
|
|
|
|
|
|
|
|
Function GetFS(Var F:File):longint;
|
|
{
|
|
Get File Descriptor of an unTyped file.
|
|
}
|
|
begin
|
|
{ Handle and mode are on the same place in textrec and filerec. }
|
|
if filerec(f).mode=fmclosed then
|
|
exit(-1)
|
|
else
|
|
GETFS:=filerec(f).Handle
|
|
end;
|
|
|
|
|
|
{--------------------------------
|
|
Stat.Mode Macro's
|
|
--------------------------------}
|
|
|
|
Function S_ISLNK(m:word):boolean;
|
|
{
|
|
Check mode field of inode for link.
|
|
}
|
|
begin
|
|
S_ISLNK:=(m and STAT_IFMT)=STAT_IFLNK;
|
|
end;
|
|
|
|
|
|
|
|
Function S_ISREG(m:word):boolean;
|
|
{
|
|
Check mode field of inode for regular file.
|
|
}
|
|
begin
|
|
S_ISREG:=(m and STAT_IFMT)=STAT_IFREG;
|
|
end;
|
|
|
|
|
|
|
|
Function S_ISDIR(m:word):boolean;
|
|
|
|
{
|
|
Check mode field of inode for directory.
|
|
}
|
|
begin
|
|
S_ISDIR:=(m and STAT_IFMT)=STAT_IFDIR;
|
|
end;
|
|
|
|
|
|
|
|
Function S_ISCHR(m:word):boolean;
|
|
{
|
|
Check mode field of inode for character device.
|
|
}
|
|
begin
|
|
S_ISCHR:=(m and STAT_IFMT)=STAT_IFCHR;
|
|
end;
|
|
|
|
|
|
|
|
Function S_ISBLK(m:word):boolean;
|
|
{
|
|
Check mode field of inode for block device.
|
|
}
|
|
begin
|
|
S_ISBLK:=(m and STAT_IFMT)=STAT_IFBLK;
|
|
end;
|
|
|
|
|
|
|
|
Function S_ISFIFO(m:word):boolean;
|
|
{
|
|
Check mode field of inode for named pipe (FIFO).
|
|
}
|
|
begin
|
|
S_ISFIFO:=(m and STAT_IFMT)=STAT_IFIFO;
|
|
end;
|
|
|
|
|
|
|
|
Function S_ISSOCK(m:word):boolean;
|
|
{
|
|
Check mode field of inode for socket.
|
|
}
|
|
begin
|
|
S_ISSOCK:=(m and STAT_IFMT)=STAT_IFSOCK;
|
|
end;
|
|
|
|
|
|
{--------------------------------
|
|
Memory functions
|
|
--------------------------------}
|
|
|
|
function MMap(const m:tmmapargs):longint;
|
|
|
|
begin
|
|
{Last argument (offset) is actually 64-bit under BSD. Therefore extra 0}
|
|
MMap:=do_syscall(syscall_nr_mmap,m.address,m.size,m.prot,m.flags,m.fd,m.offset,0);
|
|
LinuxError:=Errno;
|
|
end;
|
|
|
|
|
|
{--------------------------------
|
|
Port IO functions
|
|
--------------------------------}
|
|
{
|
|
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;
|
|
end;
|
|
}
|
|
{$IFDEF I386}
|
|
|
|
{$asmmode direct}
|
|
|
|
Procedure WritePort (Port : Longint; Value : Byte);
|
|
{
|
|
Writes 'Value' to port 'Port'
|
|
}
|
|
begin
|
|
asm
|
|
movl 8(%ebp),%edx
|
|
movb 12(%ebp),%al
|
|
outb %al,%dx
|
|
end ['EAX','EDX'];
|
|
end;
|
|
|
|
Procedure WritePort (Port : Longint; Value : Word);
|
|
{
|
|
Writes 'Value' to port 'Port'
|
|
}
|
|
|
|
begin
|
|
asm
|
|
movl 8(%ebp),%edx
|
|
movw 12(%ebp),%ax
|
|
outw %ax,%dx
|
|
end ['EAX','EDX'];
|
|
end;
|
|
|
|
|
|
|
|
Procedure WritePort (Port : Longint; Value : Longint);
|
|
{
|
|
Writes 'Value' to port 'Port'
|
|
}
|
|
|
|
begin
|
|
asm
|
|
movl 8(%ebp),%edx
|
|
movl 12(%ebp),%eax
|
|
outl %eax,%dx
|
|
end ['EAX','EDX'];
|
|
end;
|
|
|
|
|
|
|
|
Procedure WritePortl (Port : Longint; Var Buf; Count: longint);
|
|
{
|
|
Writes 'Count' longints from 'Buf' to Port
|
|
}
|
|
begin
|
|
asm
|
|
movl 16(%ebp),%ecx
|
|
movl 12(%ebp),%esi
|
|
movl 8(%ebp),%edx
|
|
cld
|
|
rep
|
|
outsl
|
|
end ['ECX','ESI','EDX'];
|
|
end;
|
|
|
|
|
|
|
|
Procedure WritePortW (Port : Longint; Var Buf; Count: longint);
|
|
{
|
|
Writes 'Count' words from 'Buf' to Port
|
|
}
|
|
begin
|
|
asm
|
|
movl 16(%ebp),%ecx
|
|
movl 12(%ebp),%esi
|
|
movl 8(%ebp),%edx
|
|
cld
|
|
rep
|
|
outsw
|
|
end ['ECX','ESI','EDX'];
|
|
end;
|
|
|
|
|
|
|
|
Procedure WritePortB (Port : Longint; Var Buf; Count: longint);
|
|
{
|
|
Writes 'Count' bytes from 'Buf' to Port
|
|
}
|
|
begin
|
|
asm
|
|
movl 16(%ebp),%ecx
|
|
movl 12(%ebp),%esi
|
|
movl 8(%ebp),%edx
|
|
cld
|
|
rep
|
|
outsb
|
|
end ['ECX','ESI','EDX'];
|
|
end;
|
|
|
|
|
|
|
|
Procedure ReadPort (Port : Longint; Var Value : Byte);
|
|
{
|
|
Reads 'Value' from port 'Port'
|
|
}
|
|
begin
|
|
asm
|
|
movl 8(%ebp),%edx
|
|
inb %dx,%al
|
|
andl $255,%eax
|
|
movl %eax,12(%ebp)
|
|
end ['EAX','EDX'];
|
|
end;
|
|
|
|
|
|
|
|
Procedure ReadPort (Port : Longint; Var Value : Word);
|
|
{
|
|
Reads 'Value' from port 'Port'
|
|
}
|
|
begin
|
|
asm
|
|
movl 8(%ebp),%edx
|
|
inw %dx,%ax
|
|
andl $65535,%eax
|
|
movl %eax,12(%ebp)
|
|
end ['EAX','EDX'];
|
|
end;
|
|
|
|
|
|
|
|
Procedure ReadPort (Port : Longint; Var Value : Longint);
|
|
{
|
|
Reads 'Value' from port 'Port'
|
|
}
|
|
begin
|
|
asm
|
|
movl 8(%ebp),%edx
|
|
inl %dx,%eax
|
|
movl %eax,12(%ebp)
|
|
end ['EAX','EDX'];
|
|
end;
|
|
|
|
|
|
Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);
|
|
{
|
|
Reads 'Count' longints from port 'Port' to 'Buf'.
|
|
}
|
|
begin
|
|
asm
|
|
movl 16(%ebp),%ecx
|
|
movl 12(%ebp),%edi
|
|
movl 8(%ebp),%edx
|
|
cld
|
|
rep
|
|
insl
|
|
end ['ECX','EDI','EDX'];
|
|
end;
|
|
|
|
|
|
|
|
Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);
|
|
{
|
|
Reads 'Count' words from port 'Port' to 'Buf'.
|
|
}
|
|
begin
|
|
asm
|
|
movl 16(%ebp),%ecx
|
|
movl 12(%ebp),%edi
|
|
movl 8(%ebp),%edx
|
|
cld
|
|
rep
|
|
insw
|
|
end ['ECX','EDI','EDX'];
|
|
end;
|
|
|
|
|
|
|
|
Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);
|
|
{
|
|
Reads 'Count' bytes from port 'Port' to 'Buf'.
|
|
}
|
|
begin
|
|
asm
|
|
movl 16(%ebp),%ecx
|
|
movl 12(%ebp),%edi
|
|
movl 8(%ebp),%edx
|
|
cld
|
|
rep
|
|
insb
|
|
end ['ECX','EDI','EDX'];
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
Initialization
|
|
InitLocalTime;
|
|
|
|
finalization
|
|
DoneLocalTime;
|
|
|
|
End.
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.12 2000-04-10 15:46:51 marco
|
|
* worked all day. probably a lot changed
|
|
|
|
Revision 1.10 2000/04/05 13:46:22 marco
|
|
* rest of syscalls has constants now
|
|
|
|
Revision 1.9 2000/04/05 13:07:03 marco
|
|
* replaced about half of the syscall nr's by symbols from sysnr.inc
|
|
|
|
Revision 1.8 2000/03/17 12:58:57 marco
|
|
* some changes to ftruncate based procs. Added a "0" as extra parameter
|
|
|
|
Revision 1.7 2000/03/16 16:19:28 marco
|
|
* fixes that made ppc386 -h working
|
|
|
|
Revision 1.6 2000/03/02 15:33:20 marco
|
|
* fixed some types and errors that needed longint(@ typecasting.
|
|
|
|
Revision 1.5 2000/03/01 20:04:38 marco
|
|
* some small fixes.
|
|
|
|
Revision 1.4 2000/03/01 17:27:46 marco
|
|
* Fixed first half of linux unit to portable syscall struct.
|
|
|
|
Revision 1.3 2000/02/04 16:53:26 marco
|
|
* Finished Linux (and rest syscalls) roughly. Some things still need to be
|
|
tested, and checked (off_t calls specially)
|
|
|
|
Revision 1.2 2000/02/04 12:05:04 marco
|
|
* a few functions added.
|
|
|
|
Revision 1.1 2000/02/03 17:03:36 marco
|
|
* initial version. Ported till line +/- 2000
|
|
|
|
|
|
} |