diff --git a/rtl/bsd/linux.pp b/rtl/bsd/linux.pp new file mode 100644 index 0000000000..c680e6e4d6 --- /dev/null +++ b/rtl/bsd/linux.pp @@ -0,0 +1,4003 @@ +{ + $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; { Obsolete - Don't use } + 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:Integer):integer; +Procedure Fcntl(Fd:longint;Cmd:Integer;Arg:Longint); +Function Fcntl(var Fd:Text;Cmd:Integer):integer; +Procedure Fcntl(var Fd:Text;Cmd:Integer;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 GetEnv(P:string):Pchar; +Function Sysinfo(var Info:TSysinfo):Boolean; +Function Uname(var unamerec:utsname):Boolean; + +{************************** + 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} + +{ 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. +} + +var retval: LONGINT; + +Begin + asm + movl $2,%eax + int $0x80 + mov %eax,retval + end; + fork:=checkreturnvalue(retval,retval); + 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. +} + +var retval: LONGINT; + +Begin + path:=path+#0; + asm + lea %ebx,path + inc %ebx + pushl ep + pushl args + pushl %ebx + movl $59,%eax + int $0x80 + addl $12,%esp + mov %eax,retval + end; + checkreturnvalue(retval,retval); +{ This only gets set when the call fails, otherwise we don't get here ? } + 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. +} + +var retval: LONGINT; + +Begin + asm + pushl ep + pushl args + pushl path + movl $59,%eax + int $0x80 + addl $12,%esp + mov %eax,retval + end; + checkreturnvalue(retval,retval); +{ This only gets set when the call fails, otherwise we don't get here ? } + 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); + +var retval : longint; + +begin + asm + pushl Val + mov $1,%eax + int $0x80 + addl $4,%eax + mov %eax,retval + end; + checkreturnvalue(retval,retval); +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. +} + +var retval : longint; + +begin + asm + pushl $0 // BSD wait4 call has extra parameter + push Options + push Status + push Pid + mov $7,%eax + int $0x80 + addl $16,%eax + mov %eax,retval + end; + WaitPID:=checkreturnvalue(retval,retval); + 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) +} +var + retval : longint; +begin + errno:=0; + if (whichprio_user) then + begin + { We can save an interrupt here } + getpriority:=0; + linuxerror:=Sys_einval; + end + else + begin + asm + pushl who + pushl which + int $0x80 + addl $8,%eax + mov %eax,retval + end; + Getpriority:=checkreturnvalue(retval,retval); + 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. +} +var + retval : longint; +begin + errno:=0; + if ((whichprio_user)) or ((what<-20) or (what>20)) then + linuxerror:=Sys_einval { We can save an interrupt here } + else + begin + asm + pushl what + pushl who + pushl which + mov $96,%eax + int $0x80 + addl $12,%eax + mov %eax,retval + end; + checkreturnvalue(retval,retval); + 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. +} +var retval : longint; + +begin + asm + mov $20,%eax + int $0x80 + mov %eax,retval + end; + GetPID:=checkreturnvalue(retval,retval); + LinuxError:=errno; +end; + +Function GetPPid:LongInt; +{ + Get Process ID of parent process. +} + +var retval : longint; + +begin + asm + mov $39,%eax + int $0x80 + mov %eax,retval + end; + GetpPID:=checkreturnvalue(retval,retval); + LinuxError:=errno; +end; + +Function GetUid:Longint; +{ + Get User ID. +} + +var retval : longint; + +begin + asm + mov $24,%eax + int $0x80 + mov %eax,retval + end; + GetUID:=checkreturnvalue(retval,retval); + LinuxError:=errno; +end; + + + +Function GetEUid:Longint; +{ + Get _effective_ User ID. +} + +var retval : longint; + +begin + asm + mov $25,%eax + int $0x80 + mov %eax,retval + end; + GetEUID:=checkreturnvalue(retval,retval); + LinuxError:=errno; +end; + + +Function GetGid:Longint; +{ + Get Group ID. +} + +var retval : longint; + +begin + asm + mov $47,%eax + int $0x80 + mov %eax,retval + end; + GetGID:=checkreturnvalue(retval,retval); + LinuxError:=errno; +end; + + +Function GetEGid:Longint; +{ + Get _effective_ Group ID. +} +var retval : longint; + +begin + asm + mov $43,%eax + int $0x80 + mov %eax,retval + end; + GetEGID:=checkreturnvalue(retval,retval); + 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; + retval : longint; + +begin + asm + lea tz,%ebx + pushl %ebx + lea tv,%ecx + pushl %ecx + mov $116,%eax + int $0x80 + add $8,%esp + mov %eax,retval + end; + checkreturnvalue(retval,retval); + 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; + +Var Retval : LONGINT; + +begin + asm + push size + push fd + mov $201,%eax + int $0x80 + addl $8,%esp + mov %eax,retval + end; + fdtruncate:=checkreturnvalue(retval,retval)=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; + +Var Retval : LONGINT; + +begin + asm + push fd + mov $95,%eax + int $0x80 + addl $4,%esp + mov %eax,retval + end; + fdflush:=checkreturnvalue(retval,retval)=0; + LinuxError:=Errno; +end; + +function sys_fcntl(Fd:longint;Cmd:Integer;Arg:Longint):longint; + +var retval : LONGINT; + +begin + asm + push arg + push cmd + push fd + mov $92,%eax + int $0x80 + addl $12,%esp + mov %eax,retval + end; + sys_fcntl:=checkreturnvalue(retval,retval); + LinuxError:=Errno; +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 + 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: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]) then + begin + sys_fcntl(fd,cmd,arg); + LinuxError:=ErrNo; + end + else + linuxerror:=Sys_einval; +end; + + +Function Fcntl(var Fd:Text;Cmd:integer):integer; +begin + Fcntl := Fcntl(textrec(Fd).handle, Cmd); +end; + +Procedure Fcntl(var Fd:Text;Cmd:Integer;Arg:Longint); +begin + Fcntl(textrec(Fd).handle, Cmd, Arg); +end; + + +Function Chmod(path:pathstr;Newmode:longint):Boolean; +{ + Changes the permissions of a file. +} +var + retval : longint; +begin + path:=path+#0; + asm + lea %ebx,path + inc %ebx + push newmode + push %ebx + mov $15,%eax + int $0x80 + addl $8,%esp + mov %eax,retval + end; + ChMod:=checkreturnvalue(retval,retval)=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. +} + +var retval : longint; + +begin + path:=path+#0; + asm + lea %ebx,path + inc %ebx + push newgid + push newuid + push %ebx + mov $16,%eax + int $0x80 + addl $12,%esp + mov %eax,retval + end; + Chown:=checkreturnvalue(retval,retval)=0; + LinuxError:=Errno; +end; + +Function Utime(path:pathstr;utim:utimebuf):boolean; +var + Retval : longint; +begin + asm + lea %ebx,path + inc %ebx + push utim + push %ebx + mov $138,%eax + int $0x80 + addl $12,%esp + mov %eax,retval + end; + utime:=checkreturnvalue(retval,retval)=0; + LinuxError:=Errno; +end; + +Function Flock (fd,mode : longint) : boolean; + +var + Retval : longint; +begin + asm + push mode + push fd + mov $131,%eax + int $0x80 + addl $8,%esp + mov %eax,retval + end; + flock:=checkreturnvalue(retval,retval)=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. +} + +var + Retval : longint; +begin + asm + push info + push fd + mov $189,%eax + int $0x80 + addl $8,%esp + mov %eax,retval + end; + FStat:=checkreturnvalue(retval,retval)=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. +} +var + Retval : longint; +begin + FileName:=FileName+#0; + asm + lea filename,%ebx + inc %ebx + push info + push %ebx + mov $189,%eax + int $0x80 + addl $8,%esp + mov %eax,retval + end; + LStat:=checkreturnvalue(retval,retval)=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. +} + +var + Retval : longint; +begin + path:=path+#0; + asm + lea path,%ebx + inc %ebx + push info + push %ebx + mov $157,%eax + int $0x80 + addl $8,%esp + mov %eax,retval + end; + FSStat:=checkreturnvalue(retval,retval)=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. +} + +var + Retval : longint; +begin + asm + push info + push fd + mov $158,%eax + int $0x80 + addl $8,%esp + mov %eax,retval + end; + FSStat:=checkreturnvalue(retval,retval)=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. +} +var + retval : longint; +begin + oldpath:=oldpath+#0; + newpath:=newpath+#0; + asm + lea oldpath,%ebx + lea newpath,%ecx + inc %ebx + inc %ecx + push %ecx + push %ebx + mov $9,%eax + int $0x80 + addl $8,%esp + mov %eax,retval + end; + Link:=checkreturnvalue(retval,retval)=0; + LinuxError:=Errno; +end; + +Function SymLink(OldPath,newPath:pathstr):boolean; +{ + Proceduces a soft link from new to old. +} + +var + retval : longint; +begin + oldpath:=oldpath+#0; + newpath:=newpath+#0; + asm + lea oldpath,%ebx + lea newpath,%ecx + inc %ebx + inc %ecx + push %ecx + push %ebx + mov $57,%eax + int $0x80 + addl $8,%esp + mov %eax,retval + end; + SymLink:=checkreturnvalue(retval,retval)=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. +} +var + retval : longint; +begin + asm + pushw mask + mov $60,%eax + int $0x80 + addl $2,%esp + mov %eax,retval + end; + Umask:=checkreturnvalue(retval,retval); + 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. +} + +var + retval : longint; +begin + path:=path+#0; + asm + lea path,%ebx + inc %ebx + push mode + push %ebx + mov $33,%eax + int $0x80 + addl $8,%esp + mov %eax,retval + end; + Access:=checkreturnvalue(retval,retval)=0; + LinuxError:=Errno; +end; + +Function Dup(oldfile:longint;var newfile:longint):Boolean; +{ + Copies the filedescriptor oldfile to newfile +} + +var + retval : longint; +begin + asm + push oldfile + mov $41,%eax + int $0x80 + addl $4,%esp + mov %eax,retval + end; + NewFile:=checkreturnvalue(retval,retval); + 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 +} +var + retval : longint; +begin + asm + push newfile + push oldfile + mov $90,%eax + int $0x80 + addl $8,%esp + mov %eax,retval + end; + checkreturnvalue(retval,retval); + 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. +} +Var + SelectArray : Array[1..5] of longint; + Sr : Syscallregs; +begin + SelectArray[1]:=n; + SelectArray[2]:=longint(Readfds); + Selectarray[3]:=longint(Writefds); + selectarray[4]:=longint(exceptfds); + Selectarray[5]:=longint(TimeOut); + sr.reg2:=longint(@selectarray); + Select:=SysCall(Syscall_nr_select,sr); + 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; + regs : SysCallregs; +begin + regs.reg2:=longint(@pip); + SysCall(SysCall_nr_pipe,regs); + pipe_in:=pip[1]; + pipe_out:=pip[2]; + linuxerror:=errno; + 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 + sr : syscallregs; + pl : ^longint; + res : longint; +begin + sr.reg2:=Textrec(F).Handle; + SysCall (syscall_nr_close,sr); +{ 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 + sr : syscallregs; + pl : ^longint; + res : longint; +begin + sr.reg2:=FileRec(F).Handle; + SysCall (Syscall_nr_close,sr); +{ 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; +var + regs : SysCallRegs; +begin + pathname:=pathname+#0; + regs.reg2:=longint(@pathname[1]); + regs.reg3:=mode or STAT_IFIFO; + regs.reg4:=0; + mkFifo:=(SysCall(syscall_nr_mknod,regs)=0); +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. +} +var + regs : Syscallregs; +begin + regs.reg2:=Pid; + regs.reg3:=Sig; + kill:=SysCall(Syscall_nr_kill,regs); + 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. +} +Var + sr : Syscallregs; +begin + sr.reg2:=Signum; + sr.reg3:=Longint(act); + sr.reg4:=Longint(oldact); + SysCall(Syscall_nr_sigaction,sr); + 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. +} +Var + sr : SyscallRegs; +begin + sr.reg2:=how; + sr.reg3:=longint(SSet); + sr.reg4:=longint(OldSSet); + SysCall(Syscall_nr_sigprocmask,sr); + linuxerror:=errno; +end; + + + +Function SigPending:SigSet; +{ + Allows examination of pending signals. The signal mask of pending + signals is set in SSet +} +Var + sr : SyscallRegs; + dummy : Sigset; +begin + sr.reg2:=longint(@dummy); + SysCall(Syscall_nr_sigpending,sr); + linuxerror:=errno; + Sigpending:=dummy; +end; + + + +Procedure SigSuspend(Mask:Sigset); +{ + Set the signal mask with Mask, and suspend the program until a signal + is received. +} +Var + sr : SyscallRegs; +begin + sr.reg2:=mask; + SysCall(Syscall_nr_sigsuspend,sr); + 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. +} +var + sr : Syscallregs; +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. +} +var + sr: SysCallRegs; +begin + sr.reg2:=Handle; + sr.reg3:=Ndx; + sr.reg4:=Longint(Data); + IOCtl:=(SysCall(Syscall_nr_ioctl,sr)=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 (ipattern[i]) do + inc (j); + if (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; +Var + Sr : Syscallregs; +begin + Sr.reg2:=longint(@m); + MMap:=syscall(syscall_nr_mmap,sr); + 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.1 2000-02-03 17:03:36 marco + * initial version. Ported till line +/- 2000 + + +} \ No newline at end of file