{ $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 }