From 352c48bb4002dc02aafedb61b884be8950f9f641 Mon Sep 17 00:00:00 2001 From: marco Date: Sun, 16 Apr 2000 16:10:35 +0000 Subject: [PATCH] * Is now merged --- rtl/bsd/linux.pp | 3682 ---------------------------------------------- 1 file changed, 3682 deletions(-) delete mode 100644 rtl/bsd/linux.pp diff --git a/rtl/bsd/linux.pp b/rtl/bsd/linux.pp deleted file mode 100644 index 077ce598d0..0000000000 --- a/rtl/bsd/linux.pp +++ /dev/null @@ -1,3682 +0,0 @@ -{ - $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 (whichprio_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 ((whichprio_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 (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; - -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 - - -} \ No newline at end of file