freepascal.compiler/rtl/linux/linux.pp

{
    This file is part of the Free Pascal run time library.
    Copyright (c) 1993,97 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
  { For getting/setting priority }
  Prio_Process = 0;
  Prio_PGrp    = 1;
  Prio_User    = 2;

{********************
      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 : Integer);
  PSignalHandler  = ^SignalHandler;
  SignalRestorer  = Procedure;
  PSignalRestorer = ^SignalRestorer;

  SigSet  = Integer;
  PSigSet = ^SigSet;
  
{$PACKRECORDS 1}
  SigActionRec = record
    Sa_Handler : ^SignalHandler;
    Sa_Mask : longint;
    Sa_Flags : Integer;
    Sa_restorer : ^SignalRestorer;{ Obsolete - Don't use }
  end;
  PSigActionRec = ^SigActionRec;
{$PACKRECORDS NORMAL}


{********************
   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
{$PACKRECORDS 1}
  winsize = record
    ws_row,
    ws_col,
    ws_xpixel,
    ws_ypixel : byte;
  end;

  TermIO = 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;

  TermIOS = record
    c_iflag,              
    c_oflag,              
    c_cflag,              
    c_lflag  : longint;
    c_line  : char;         
    c_cc     : array[0..NCCS-1] of byte;
  end;
{$PACKRECORDS 2}

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
{$PACKRECORDS 1}
  utimbuf = record
    actime,modtime : Longint;
  end;

  TSysinfo = record
    uptime    : longint;
    loads     : array[1..3] of longint;
    totalram,
    freeram,
    sharedram,
    bufferram,
    totalswap,
    freeswap  : longint;
    procs     : integer;
    s         : string[18];
  end;
{$PACKRECORDS 2}

{******************************************************************************
                            Procedure/Functions
******************************************************************************}

Function SysCall(callnr:longint;var regs:SysCallregs):longint;

{**************************
     Time/Date Handling
***************************}

Function  GetEpochTime:longint;
Procedure GetTimeOfDay(var tv:timeval;var tz:timezone);
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,Minute,Second:Word);
Procedure GetDate(Var Year,Month,Day:Word);
{ For compatibility with earlier versions }
Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Integer);
Function  LocalToEpoch(year,month,day,hour,minute,second:Integer):Longint;
Procedure GetTime(Var Hour,Minute,Second:Integer);
Procedure GetDate(Var Year,Month,Day:Integer);

{**************************
     Process Handling
***************************}

Procedure Execve(Path:pathstr;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(Command:String):Longint;
Function  Fork:longint;
Function  WaitPid(Pid:longint;Status:pointer;Options:Integer):Longint;
Procedure Nice(N:integer);
Function  GetPriority(Which,Who:Integer):integer;
Procedure SetPriority(Which:Integer;Who:Integer;What:Integer);
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  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  Link(OldPath,NewPath:pathstr):boolean;
Function  SymLink(OldPath,NewPath:pathstr):boolean;
Function  UnLink(Path:pathstr):boolean;
Function  Chown(path:pathstr;NewUid,NewGid:longint):boolean;
Function  Chmod(path:pathstr;Newmode:longint):boolean;
Function  Utime(path:pathstr;utim:utimbuf):boolean;
Function  Access(Path:Pathstr ;mode:integer):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:Text;Cmd:Integer):integer;
Procedure Fcntl(Fd:Text;Cmd:Integer;Arg:Longint);
Function  Dup(oldfile,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;
Procedure PClose(Var F:text);
Procedure PClose(Var F:file);
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);

{**************************
    General information
***************************}

Function  GetDomainName:String;
Function  GetHostName:String;
Function  GetEnv(P:string):Pchar;
Function  Sysinfo(var Info:TSysinfo):Boolean;
Function  Uname(var unamerec:utsname):Boolean;

{**************************
        Signal
***************************}

Procedure SigAction(Signum:Integer;Var Act,OldAct:PSigActionRec );
Procedure SigProcMask (How:Integer;SSet,OldSSet:PSigSet);
Function  SigPending:SigSet;
Procedure SigSuspend(Mask:Sigset);
Function  Signal(Signum:Integer;Handler:PSignalHandler):PSignalHandler;
Function  Kill(Pid:longint;Sig:integer):integer;

{**************************
  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;

{**************************
    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:integer):boolean;
Function S_ISREG(m:integer):boolean;
Function S_ISDIR(m:integer):boolean;   
Function S_ISCHR(m:integer):boolean;
Function S_ISBLK(m:integer):boolean;
Function S_ISFIFO(m:integer):boolean;
Function S_ISSOCK(m:integer):boolean;


{******************************************************************************
                            Implementation
******************************************************************************}

Implementation

Uses Strings;

var
  LocalTZ:TimeZone;


{ Get the definitions of textrec and filerec }
{$i textrec.inc}
{$i filerec.inc}

{ Raw System calls are in Syscalls.inc}
{$i syscalls.inc}



{******************************************************************************
                          Process related calls
******************************************************************************}


Function Fork:longint;
{
  This function issues the 'fork' System call. the program is duplicated in memory
  and Execution continues in parent and child process.
  In the parent process, fork returns the PID of the child. In the child process,
  zero is returned.
  A negative value indicates that an error has occurred, the error is returned in
  LinuxError.
}
var
  regs:SysCallregs;
begin
  Fork:=SysCall(SysCall_nr_fork,regs);
  LinuxError:=Errno;
End;



Procedure Execve(path:pathstr;args:ppchar;ep:ppchar);
{
  Replaces the current program by the program specified in path,
  arguments in args are passed to Execve.
  environment specified in ep is passed on.
}
var
  regs:SysCallregs;
begin
  path:=path+#0;
  regs.reg2:=longint(@path[1]);
  regs.reg3:=longint(args);
  regs.reg4:=longint(ep);
  SysCall(SysCall_nr_Execve,regs);
{ This only gets set when the call fails, otherwise we don't get here ! }
  Linuxerror:=errno;
end;



Procedure Execv(const path:pathstr;args:ppchar);
{
  Replaces the current program by the program specified in path,
  arguments in args are passed to Execve.
  the current environment is passed on.
}
begin
  Execve(path,args,envp); {On error linuxerror will get set there}
end;



Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
{
  This does the same as Execve, only it searches the PATH environment
  for the place of the Executable, except when Path starts with a slash.
  if the PATH environment variable is unavailable, the path is set to '.'
}
var
  thepath : string;
begin
  if path[1]<>'/' then
   begin
     Thepath:=strpas(getenv('PATH'));
     if thepath='' then
      thepath:='.';
     Path:=FSearch(path,thepath)
   end
  else
   Path:='';
  if Path='' then
   linuxerror:=Sys_enoent
  else
   Execve(Path,args,ep);{On error linuxerror will get set there}
end;



Procedure Execle(Todo:string;Ep:ppchar);
{
  This procedure takes the string 'Todo', parses it for command and
  command options, and Executes the command with the given options.
  The string 'Todo' shoud be of the form 'command options', options
  separated by commas.
  the PATH environment is not searched for 'command'.
  The specified environment(in 'ep') is passed on to command
}
var
  p : ppchar;
begin
  p:=StringToPPChar(ToDo);
  if (p=nil) or (p^=nil) then
   exit; 
  ExecVE(StrPas(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;



Function WaitPid(Pid:longint;Status:pointer;Options:Integer):Longint;
{
  Waits until a child with PID Pid exits, or returns if it is exited already.
  Any resources used by the child are freed.
  The exit status is reported in the adress referred to by Status. It should
  be a longint.
}
var
  regs : SysCallregs;
begin
  regs.reg2:=pid;
  regs.reg3:=longint(status);
  regs.reg4:=options;
  WaitPid:=SysCall(SysCall_nr_waitpid,regs);
  LinuxError:=errno;
end;



Function Shell(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,pp     : ppchar;
  sh       : string[12];
  temp,pid : longint;
begin
  sh:='/bin/sh'#0'-c'#0;
  Command:=Command+#0;
  getmem(pp,12);
  if pp=nil then
   begin
     LinuxError:=Sys_enomem;
     exit;
   end;
  pp^:=@sh[1];
  p:=pp+4;
  p^:=@sh[9];
  p:=p+4;
  p^:=@command[1];
  pid:=fork;
  if pid=-1 then
   exit; {Linuxerror already set in Fork}
  if pid=0 then
   begin
     {This is the child.}
     Execve('/bin/sh',pp,envp);
     exit(127);
   end;
  temp:=0;
  WaitPid(pid,@temp,0);{Linuxerror is set there}
  Shell:=temp;{ Return exit status }
end;



Function GetPriority(Which,Who:Integer):integer;
{
  Get Priority of process, process group, or user.
   Which : selects what kind of priority is used.
           can be one of the following predefined Constants :
              Prio_User.
              Prio_PGrp.
              Prio_Process.
   Who : depending on which, this is , respectively :
              Uid
              Pid
              Process Group id
   Errors are reported in linuxerror _only_. (priority can be negative)
}
var
  sr : Syscallregs;
begin
  errno:=0;
  if (which<prio_process) or (which>prio_user) then
   begin
     { We can save an interrupt here }
     getpriority:=0;
     linuxerror:=Sys_einval;
   end
  else
   begin
     sr.reg2:=which;
     sr.reg3:=who;
     getpriority:=SysCall(Syscall_nr_getpriority,sr);
     linuxerror:=errno;
   end;
end;



Procedure SetPriority(Which:Integer;Who:Integer;What:Integer);
{
 Set Priority of process, process group, or user.
   Which : selects what kind of priority is used.
           can be one of the following predefined Constants :
              Prio_User.
              Prio_PGrp.
              Prio_Process.
   Who : depending on value of which, this is, respectively :
              Uid
              Pid
              Process Group id
   what : A number between -20 and 20. -20 is most favorable, 20 least.
          0 is the default.
}
var
  sr : Syscallregs;
begin
  errno:=0;
  if ((which<prio_process) or (which>prio_user)) or ((what<-20) or (what>20)) then
   linuxerror:=Sys_einval  { We can save an interrupt here }
  else
   begin
     sr.reg2:=which;
     sr.reg3:=who;
     sr.reg4:=what;
     SysCall(Syscall_nr_setpriority,sr);
     linuxerror:=errno;
   end;
end;


Procedure Nice(N:integer);
{
  Set process priority. A positive N means a lower priority.
  A negative N decreases priority.
}
var
  sr : Syscallregs;
begin
  sr.reg2:=n;
  SysCall(Syscall_nr_nice,sr);
  linuxerror:=errno;
end;



Function GetPid:LongInt;
{
  Get Process ID.
}
var
  regs : SysCallregs;
begin
  GetPid:=SysCall(SysCall_nr_getpid,regs);
  linuxerror:=errno;
end;



Function GetPPid:LongInt;
{
  Get Process ID of parent process.
}
var
  regs : SysCallregs;
begin
  GetPpid:=SysCall(SysCall_nr_getppid,regs);
  linuxerror:=errno;
end;



Function GetUid:Longint;
{
  Get User ID.
}
var
  regs : SysCallregs;
begin
  GetUid:=SysCall(SysCall_nr_getuid,regs);
  Linuxerror:=errno;
end;



Function GetEUid:Longint;
{
  Get _effective_ User ID.
}
var
  regs : SysCallregs;
begin
  GetEuid:=SysCall(SysCall_nr_geteuid,regs);
  Linuxerror:=errno;
end;



Function GetGid:Longint;
{
  Get Group ID.
}
var
  regs : SysCallregs;
begin
  Getgid:=SysCall(SysCall_nr_getgid,regs);
  Linuxerror:=errno;
end;



Function GetEGid:Longint;
{
  Get _effective_ Group ID.
}
var
  regs : SysCallregs;
begin
  GetEgid:=SysCall(SysCall_nr_getegid,regs);
  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 : 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;
  Month:=Temp Div 153;
  If Month>=10 Then
   Begin
     inc(YYear);
     dec(Month,12);
   End;
  inc(Month,3);
  Year:=YYear+(JulianDN*100);
end;



Procedure GetTimeOfDay(var tv:timeval;var tz:timezone);
{
 Get the time of day and timezone.
}
var
  regs : SysCallregs;
begin
  regs.reg2:=longint(@tv);
  regs.reg3:=longint(@tz);
  SysCall(SysCall_nr_gettimeofday,regs);
  LinuxError:=Errno;
end;


Function GetTimeOfDay: longint;
{
  Get the number of seconds since 00:00, January 1 1970, GMT
  the time NOT corrected any way
}
var
  t  : timeval ;
  tz : timezone ;
begin
  gettimeofday(t,tz);{Sets LinuxError also}
  GetTimeOfDay:=t.sec;
end;



Function GetEpochTime:longint;
{
  Get the number of seconds since 00:00, January 1 1970, GMT
  the time is corrected according to the time zone, but NOT
  DST corrected.
}
var
  t : timeval ;
  tz : timezone ;
begin
  gettimeofday(t,tz);{Sets LinuxError also}
  Getepochtime:=t.sec-tz.minuteswest*60;
end;



Procedure InitEpochToLocal;
var
  tv:TimeVal;
begin
  GetTimeOfDay(tv,LocalTZ);
end;



Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
{
  Transforms Epoch time(seconds since 00:00, january 1 1970, corrected for
  local time zone) into local time (hour, minute,seconds)
}
Var
  DateNum: LongInt;
Begin { Beginning of Localtime }
  dec(Epoch,LocalTZ.minuteswest*60);
  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+(LocalTZ.minuteswest*60);
End;



Procedure GetTime(Var Hour,Minute,Second:Word);
{
  Gets the current time, adjusted to local time, but not DST,
  in hours, minutes and seconds.
}
var
  year,day,month:Word;
Begin
  EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
End;



Procedure GetDate(Var Year,Month,Day:Word);
{
  Gets the current date, adjusted to local time, but not DST,
  in year,month,day.
}
var
  hour,minute,second : Word;
Begin
  EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
End;



{ The now following are for compatibility with earlier versions
  of the linux unit... }

Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Integer);
begin
  EpochToLocal(epoch,word(year),word(month),word(day),word(hour),word(minute),word(second));
end;

Function  LocalToEpoch(year,month,day,hour,minute,second:Integer):Longint;
begin
  LocalToEpoch:=LocalToEpoch(word(year),word(month),word(day),word(hour),word(minute),word(second));
end;

Procedure GetTime(Var Hour,Minute,Second:Integer);
begin
 GetTime(Word(Hour),Word(Minute),Word(Second));
end;

Procedure GetDate(Var Year,Month,Day:Integer);
begin
  GetDate(Word(Year),Word(Month),Word(Day));
end;


{******************************************************************************
                           FileSystem calls
******************************************************************************}

Function fdOpen(pathname:string;flags:longint):longint;
begin
  pathname:=pathname+#0;
  fdOpen:=Sys_Open(@pathname[1],flags,0);
  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 fdClose(fd:longint):boolean;
begin
  fdClose:=(Sys_Close(fd)=0);
  LinuxError:=Errno;
end;



Function fdRead(fd:longint;var buf;size:longint):longint;
begin
  fdRead:=Sys_Read(fd,pchar(@buf),size);
  LinuxError:=Errno;
end;



Function fdWrite(fd:longint;var buf;size:longint):longint;
begin
  fdWrite:=Sys_Write(fd,pchar(@buf),size);
  LinuxError:=Errno;
end;



Function fdTruncate(fd,size:longint):boolean;
var
  Regs : SysCallRegs;
begin
  Regs.reg2:=fd;
  Regs.reg3:=size;
  fdTruncate:=(SysCall(Syscall_nr_ftruncate,regs)=0);
  LinuxError:=Errno;
end;



Function Fcntl(Fd:Text;Cmd:integer):integer;
{
  Read or manipulate a file.(See also fcntl (2) )
  Possible values for Cmd are :
    F_GetFd,F_GetFl,F_GetOwn
  Errors are reported in Linuxerror;
  If Cmd is different from the allowed values, linuxerror=Sys_eninval.
}
var
  sr : Syscallregs;
begin
  if (cmd in [F_GetFd,F_GetFl,F_GetOwn]) then      
   begin
     sr.reg2:=textrec(fd).handle;
     sr.reg3:=cmd;
     Linuxerror:=SysCall(Syscall_nr_fcntl,sr);
     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:Text;Cmd:Integer;Arg:Longint);
{
  Read or manipulate a file. (See also fcntl (2) )
  Possible values for Cmd are :
    F_setFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkW,F_SetOwn;
  Errors are reported in Linuxerror;
  If Cmd is different from the allowed values, linuxerror=Sys_eninval.
  F_DupFD is not allowed, due to the structure of Files in Pascal.
}
var
  sr : Syscallregs;
begin
  if (cmd in [F_SetFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkw,F_SetOwn]) then      
   begin
     sr.reg2:=textrec(fd).handle;
     sr.reg3:=cmd;
     sr.reg4:=arg;
     SysCall(Syscall_nr_fcntl,sr);
     linuxerror:=errno;
   end
  else
   linuxerror:=Sys_einval;
end;



Function Chmod(path:pathstr;Newmode:longint):Boolean;
{
  Changes the permissions of a file.
}
var
  sr : Syscallregs;
begin
  path:=path+#0;
  sr.reg2:=longint(@(path[1]));
  sr.reg3:=newmode;
  Chmod:=(SysCall(Syscall_nr_chmod,sr)=0);
  linuxerror:=errno;
end;



Function Chown(path:pathstr;NewUid,NewGid:longint):boolean;
{
  Change the owner and group of a file.
  A user can only change the group to a group of which he is a member.
  The super-user can change uid and gid of any file.
}
var
  sr : Syscallregs;
begin
  path:=path+#0;
  sr.reg2:=longint(@(path[1]));
  sr.reg3:=newuid;
  sr.reg4:=newgid;
  ChOwn:=(Syscall(Syscall_nr_chown,sr)=0);
  linuxerror:=errno;
end;



Function Utime(path:pathstr;utim:utimbuf):boolean;
var
  sr : Syscallregs;
begin
  path:=path+#0;
  sr.reg2:=longint(@(path[1]));
  sr.reg3:=longint(@utim);
  Utime:=SysCall(Syscall_nr_utime,sr)=0;
  linuxerror:=errno;
end;



Function  Flock (fd,mode : longint) : boolean;

var sr : Syscallregs;
begin
  sr.reg2:=fd;
  sr.reg3:=mode;
  flock:=Syscall(Syscall_nr_flock,sr)=0;
  LinuxError:=errno;
end;



Function Flock (var T : text;mode : longint) : boolean;

begin
  Flock:=Flock( TextRec(T).Handle,mode );
end;



Function  Flock (var F : File;mode : longint) : boolean;

begin
  Flock:=Flock(FileRec(F).Handle,mode);
end;



Function FStat(Path:Pathstr;Var Info:stat):Boolean;
{
  Get all information on a file, and return it in Info.
}
begin
  path:=path+#0;
  FStat:=(Sys_stat(@(path[1]),Info)=0);
  LinuxError:=errno;
end;



Function Fstat(Fd:Longint;var Info:stat):Boolean;
{
  Get all information on a file descriptor, and return it in info.
}
var
 regs : SysCallregs;
begin
  regs.reg2:=Fd;
  regs.reg3:=longint(@Info);
  FStat:=(SysCall(SysCall_nr_fstat,regs)=0);
  LinuxError:=Errno;
end;



Function  FStat(var F:Text;Var Info:stat):Boolean;
{
  Get all information on a text file, and return it in info.
}
begin
  FStat:=Fstat(TextRec(F).Handle,INfo);
end;



Function  FStat(var F:File;Var Info:stat):Boolean;
{
  Get all information on a untyped file, and return it in info.
}
begin
  FStat:=Fstat(FileRec(F).Handle,Info);
end;
  


Function Lstat(Filename: PathStr;var Info:stat):Boolean;
{
  Get all information on a link (the link itself), and return it in info.
}
var
  regs : SysCallregs;
begin
  FileName:=FileName+#0;
  regs.reg2:=longint(@filename[1]);
  regs.reg3:=longint(@Info);
  LStat:=(SysCall(SysCall_nr_lstat,regs)=0);
  LinuxError:=Errno;
end;



Function FSStat(Path:Pathstr;Var Info:statfs):Boolean;
{
  Get all information on a fileSystem, and return it in Info.
  Path is the name of a file/directory on the fileSystem you wish to
  investigate.
}
var
  regs : SysCallregs;
begin
  path:=path+#0;
  regs.reg2:=longint(@path[1]);
  regs.reg3:=longint(@Info);
  FSStat:=(SysCall(SysCall_nr_statfs,regs)=0);
  LinuxError:=errno;
end;



Function FSStat(Fd:Longint;Var Info:statfs):Boolean;
{
  Get all information on a fileSystem, and return it in Info.
  Fd is the file descriptor of a file/directory on the fileSystem
  you wish to investigate.
}
var
  regs : SysCallregs;
begin
  regs.reg2:=Fd;
  regs.reg3:=longint(@Info);
  FSStat:=(SysCall(SysCall_nr_fstatfs,regs)=0);
  LinuxError:=errno;
end;



Function Link(OldPath,NewPath:pathstr):boolean;
{
  Proceduces a hard link from new to old.
  In effect, new will be the same file as old.
}
var
  regs : SysCallregs;
begin
  oldpath:=oldpath+#0;
  newpath:=newpath+#0;
  regs.reg2:=longint(@oldpath[1]);
  regs.reg3:=longint(@newpath[1]);
  Link:=SysCall(SysCall_nr_link,regs)=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:=Sys_symlink(pchar(@(oldpath[1])),pchar(@(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 Umask(Mask:Integer):integer;
{
  Sets file creation mask to (Mask and 0777 (octal) ), and returns the
  previous value.
}
var
  sr : Syscallregs;
begin
  sr.reg2:=mask;
  Umask:=SysCall(Syscall_nr_umask,sr);
  linuxerror:=0;
end;



Function Access(Path:Pathstr ;mode:integer):boolean;
{
  Test users access rights on the specified file.
  Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
  R,W,X stand for read,write and Execute access, simultaneously.
  F_OK checks whether the test would be allowed on the file.
  i.e. It checks the search permissions in all directory components
  of the path.
  The test is done with the real user-ID, instead of the effective.
  If access is denied, or an error occurred, false is returned.
  If access is granted, true is returned.
  Errors other than no access,are reported in linuxerror.
}
var
  sr : Syscallregs;
begin
  path:=path+#0;
  sr.reg2:=longint(@(path[1]));
  sr.reg3:=mode;
  access:=(SysCall(Syscall_nr_access,sr)=0);
  linuxerror:=errno;
end;


Function Dup(oldfile,newfile:longint):Boolean;
{
  Copies the filedescriptor oldfile to newfile
}
var
  sr : Syscallregs;
begin
 sr.reg2:=oldfile;
 newfile:=Syscall(Syscall_nr_dup,sr);
 linuxerror:=errno;
 Dup:=(LinuxError=0);
end;


Function Dup(var oldfile,newfile:text):Boolean;
{
  Copies the filedescriptor oldfile to newfile, after flushing the buffer of
  oldfile.
  After which the two textfiles are, in effect, the same, except
  that they don't share the same buffer, and don't share the same
  close_on_exit flag.
}
begin
 flush(oldfile);{ We cannot share buffers, so we flush them. }
 textrec(newfile):=textrec(oldfile);
 textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
 Dup:=Dup(textrec(oldfile).handle,textrec(newfile).handle);
end;


Function Dup(var oldfile,newfile:file):Boolean;
{
  Copies the filedescriptor oldfile to newfile
}
begin
  filerec(newfile):=filerec(oldfile);
  Dup:=Dup(filerec(oldfile).handle,filerec(newfile).handle);
end;


Function Dup2(oldfile,newfile:longint):Boolean;
{
  Copies the filedescriptor oldfile to newfile
}
var
  sr : Syscallregs;
begin
 sr.reg2:=oldfile;
 sr.reg3:=newfile;
 SysCall(Syscall_nr_dup2,sr);
 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
 flush(oldfile);{ We cannot share buffers, so we flush them. }
 flush(newfile);
 tmphandle:=textrec(newfile).handle;
 textrec(newfile):=textrec(oldfile);
 textrec(newfile).handle:=tmphandle;
 textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
 Dup2:=Dup2(textrec(oldfile).handle,textrec(newfile).handle);
end;


Function Dup2(var oldfile,newfile:file):Boolean;
{
  Copies the filedescriptor oldfile to newfile
}
begin
  filerec(newfile):=filerec(oldfile);
  Dup2:=Dup2(filerec(oldfile).handle,filerec(newfile).handle);
end;


Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
{
  Select checks whether the file descriptor sets in readfs/writefs/exceptfs
  have changed.
}
Var
  SelectArray : Array[1..5] of longint;
  Sr : Syscallregs;
begin
  SelectArray[1]:=n;
  SelectArray[2]:=longint(Readfds);
  Selectarray[3]:=longint(Writefds);
  selectarray[4]:=longint(exceptfds);
  Selectarray[5]:=longint(TimeOut);
  sr.reg2:=longint(@selectarray);
  Select:=SysCall(Syscall_nr_select,sr);
  LinuxError:=Errno;
end;



Function  Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
{
  Select checks whether the file descriptor sets in readfs/writefs/exceptfs
  have changed.
  This function allows specification of a timeout as a longint.
}
var
  p  : PTimeVal;
  tv : TimeVal;
begin
  if TimeOut=-1 then
   p:=nil
  else
   begin
     tv.Sec:=Timeout div 1000;
     tv.Usec:=(Timeout mod 1000)*1000;
     p:=@tv;
   end;
  Select:=Select(N,Readfds,WriteFds,ExceptFds,p);
end;



Function SelectText(var T:Text;TimeOut :PTimeval):Longint;
Var
  F:FDSet;
begin
  if textrec(t).mode=fmclosed then
   begin
     LinuxError:=Sys_EBADF;
     exit(-1);
   end;
  FD_Zero(f);
  FD_Set(textrec(T).handle,f);
  if textrec(T).mode=fminput then
   SelectText:=select(textrec(T).handle+1,@f,nil,nil,TimeOut)
  else
   SelectText:=select(textrec(T).handle+1,nil,@f,nil,TimeOut);
end;


{******************************************************************************
                               Directory
******************************************************************************}

Function OpenDir(F:String):PDir;
begin
  F:=F+#0;
  OpenDir:=OpenDir(@F[1]);
end;


procedure SeekDir(p:pdir;off:longint);
begin
  if p=nil then
   begin
     errno:=Sys_EBADF;
     exit;
   end;
  p^.nextoff:=Sys_lseek(p^.fd,off,seek_set);
  p^.size:=0;
  p^.loc:=0;
end;


function TellDir(p:pdir):longint;
begin
  if p=nil then
   begin
     errno:=Sys_EBADF;
     telldir:=-1;
     exit;
   end;
  telldir:=Sys_lseek(p^.fd,0,seek_cur)
  { We could try to use the nextoff field here, but on my 1.2.13
    kernel, this gives nothing... This may have to do with
    the readdir implementation of libc... I also didn't find any trace of
    the field in the kernel code itself, So I suspect it is an artifact of libc.
    Michael. }
end;



Function ReadDir(P:pdir):pdirent;
begin
  ReadDir:=Sys_ReadDir(p);
  LinuxError:=Errno;
end;


{******************************************************************************
                               Pipes/Fifo
******************************************************************************}

Procedure OpenPipe(var F:Text);
begin
  case textrec(f).mode of
   fmoutput : if textrec(f).userdata[1]<>P_OUT then
               textrec(f).mode:=fmclosed;
    fminput : if textrec(f).userdata[1]<>P_IN then
               textrec(f).mode:=fmclosed;
  else
   textrec(f).mode:=fmclosed;
  end;   
end;


Procedure IOPipe(var F:text);
begin
  case textrec(f).mode of
   fmoutput : Sys_write(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufpos);
    fminput : textrec(f).bufend:=Sys_read(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufsize);
  end;   
  textrec(f).bufpos:=0;
end;


Procedure FlushPipe(var F:Text);
begin
  if (textrec(f).mode=fmoutput) and (textrec(f).bufpos<>0) then
   IOPipe(f);
  textrec(f).bufpos:=0;
end;


Procedure ClosePipe(var F:text);
begin
  textrec(f).mode:=fmclosed;
  Sys_close(textrec(f).handle);
end;



Function AssignPipe(var pipe_in,pipe_out:longint):boolean;
{
  Sets up a pair of file variables, which act as a pipe. The first one can
  be read from, the second one can be written to.
  If the operation was unsuccesful, linuxerror is set.
}
var
  pip  : tpipe;
  regs : SysCallregs;
begin
  regs.reg2:=longint(@pip);
  SysCall(SysCall_nr_pipe,regs);
  pipe_in:=pip[1];
  pipe_out:=pip[2];
  linuxerror:=errno;
  AssignPipe:=(LinuxError=0);
end;



Function AssignPipe(var pipe_in,pipe_out:text):boolean;
{
  Sets up a pair of file variables, which act as a pipe. The first one can
  be read from, the second one can be written to.
  If the operation was unsuccesful, linuxerror is set.
}
var
  f_in,f_out : longint;
begin
  if not AssignPipe(f_in,f_out) then
   begin
     AssignPipe:=false;
     exit;
   end;    
{ Set up input }
  Assign(Pipe_in,'.');
  Textrec(Pipe_in).Handle:=f_in;
  Textrec(Pipe_in).Mode:=fmInput;
  Textrec(Pipe_in).userdata[1]:=P_IN;
  TextRec(Pipe_in).OpenFunc:=@OpenPipe;
  TextRec(Pipe_in).InOutFunc:=@IOPipe;
  TextRec(Pipe_in).FlushFunc:=@FlushPipe;
  TextRec(Pipe_in).CloseFunc:=@ClosePipe;
{ Set up output }
  Assign(Pipe_out,'.');
  Textrec(Pipe_out).Handle:=f_out;
  Textrec(Pipe_out).Mode:=fmOutput;
  Textrec(Pipe_out).userdata[1]:=P_OUT;
  TextRec(Pipe_out).OpenFunc:=@OpenPipe;
  TextRec(Pipe_out).InOutFunc:=@IOPipe;
  TextRec(Pipe_out).FlushFunc:=@FlushPipe;
  TextRec(Pipe_out).CloseFunc:=@ClosePipe;
  AssignPipe:=true;
end;


Function AssignPipe(var pipe_in,pipe_out:file):boolean;
{
  Sets up a pair of file variables, which act as a pipe. The first one can
  be read from, the second one can be written to.
  If the operation was unsuccesful, linuxerror is set.
}
var
  f_in,f_out : longint;
begin
  if not AssignPipe(f_in,f_out) then
   begin
     AssignPipe:=false;
     exit;
   end;    
{ Set up input }
  Assign(Pipe_in,'.');
  Filerec(Pipe_in).Handle:=f_in;
  Filerec(Pipe_in).Mode:=fmInput;
  Filerec(Pipe_in).recsize:=1;
  Filerec(Pipe_in).userdata[1]:=P_IN;
{ Set up output }
  Assign(Pipe_out,'.');
  Filerec(Pipe_out).Handle:=f_out;
  Filerec(Pipe_out).Mode:=fmoutput;
  Filerec(Pipe_out).recsize:=1;
  Filerec(Pipe_out).userdata[1]:=P_OUT;
  AssignPipe:=true;
end;


Procedure PClose(Var F:text);
var
  sr : syscallregs;
  pl : ^longint;
  
begin
  sr.reg2:=Textrec(F).Handle;
  SysCall (syscall_nr_close,sr);
{ closed our side, Now wait for the other - this appears to be needed ?? }
  pl:=@(textrec(f).userdata[2]);
  waitpid(pl^,nil,0);
end;


Procedure PClose(Var F:file);
var
  sr : syscallregs;
  pl : ^longint;
  
begin
 sr.reg2:=FileRec(F).Handle;
 SysCall (Syscall_nr_close,sr);
{ closed our side, Now wait for the other - this appears to be needed ?? }
  pl:=@(filerec(f).userdata[2]);
  waitpid(pl^,nil,0);
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;
  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(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;
     getmem(pp,sizeof(pchar)*4);
     temp:='/bin/sh'#0'-c'#0+prog+#0;
     pp^:=@temp[1];
     p:=pp+sizeof(pchar);
     p^:=@temp[9];
     p:=p+sizeof(pchar);
     p^:=@temp[12];
     p:=p+sizeof(pchar);
     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;
        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;
     pp^:=@temp[1];
     p:=pp+sizeof(pchar);
     p^:=@temp[9];
     p:=p+sizeof(pchar);
     p^:=@temp[12];
     p:=p+sizeof(pchar);
     p^:=Nil;
     Execve('/bin/sh',pp,envp);
     halt(127);
   end
  else
   begin
   { We're in the parent }
     if rw='W' then
      begin
        close(pipi);
        f:=pipo;
      end
     else
      begin
        close(pipo);
        f:=pipi;
      end;
   {Save the process ID - needed when closing }
     pl:=@(filerec(f).userdata[2]);
     pl^:=pid;
   end;
end;


Function mkFifo(pathname:string;mode:longint):boolean;
var
  regs : SysCallRegs;
begin
  pathname:=pathname+#0;
  regs.reg2:=longint(@pathname[1]);
  regs.reg3:=mode or STAT_IFIFO;
  regs.reg4:=0;
  mkFifo:=(SysCall(syscall_nr_mknod,regs)=0);
end;


Procedure AssignStream(Var StreamIn,Streamout:text;Const Prog:String);
{
  Starts the program in 'Prog' and makes its input and output the
  other end of two pipes, which are the stdin and stdout of a program
  specified in 'Prog'.
  streamout can be used to write to the program, streamin can be used to read
  the output of the program. See the following diagram :
  Parent          Child
  STreamout -->  Input
  Streamin  <--  Output
}
var
  pipi,
  pipo : text;
  pid  : longint;
  
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}
   { 
     Let's redraw the schedule :
          Parent      Child
          pipo[1] --> pipi[1]
          pipi[0] <-- pipo[0]
      }

     close(pipo);
     // dup(pipi[0],streamin);
     // close (pipi[0]);
     close(pipi);
     // dup(pipo[1],streamout);
     // close (pipo[1]);
   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;
  while (not found) and (ep^<>nil) do
   begin
     if strlcomp(@p[1],(ep^),length(p))=0 then
      found:=true
     else
      ep:=ep+4;
   end;
  if found then
   getenv:=ep^+length(p)
  else
   getenv:=nil;
end;



Function GetDomainName:String;
{
  Get machines domain name. Returns empty string if not set.
}
Var
  Sysn : utsname;
begin
  Uname(Sysn);
  linuxerror:=errno;
  If linuxerror<>0 then
   getdomainname:=''
  else
   getdomainname:=strpas(@Sysn.domainname[0]);
end;



Function GetHostName:String;
{
  Get machines name. Returns empty string if not set.
}
Var
  Sysn : utsname;
begin
  uname(Sysn);
  linuxerror:=errno;
  If linuxerror<>0 then
   gethostname:=''
  else
   gethostname:=strpas(@Sysn.nodename[0]);
end;


{******************************************************************************
                          Signal handling calls
******************************************************************************}

Function Kill(Pid:longint;Sig:integer):integer;
{
  Send signal 'sig' to a process, or a group of processes.
  If Pid >  0 then the signal is sent to pid
     pid=-1                         to all processes except process 1
     pid < -1                         to process group -pid
  Return value is zero, except for case three, where the return value
  is the number of processes to which the signal was sent.
}
var
  regs : Syscallregs;
begin
  regs.reg2:=Pid;
  regs.reg3:=Sig;
  kill:=SysCall(Syscall_nr_kill,regs);
  if kill<0 then
   Kill:=0;
  linuxerror:=errno;
end;



Procedure SigAction(Signum:Integer;Var Act,OldAct:PSigActionRec );
{
  Change action of process upon receipt of a signal.
  Signum specifies the signal (all except SigKill and SigStop).
  If Act is non-nil, it is used to specify the new action.
  If OldAct is non-nil the previous action is saved there.
}
Var
  sr : Syscallregs;
begin
  sr.reg2:=Signum;
  sr.reg3:=Longint(act);
  sr.reg4:=Longint(oldact);
  SysCall(Syscall_nr_sigaction,sr);
  linuxerror:=errno;
end;



Procedure SigProcMask(How:Integer;SSet,OldSSet:PSigSet);
{
  Change the list of currently blocked signals.
  How determines which signals will be blocked :
   SigBlock   : Add SSet to the current list of blocked signals
   SigUnBlock : Remove the signals in SSet from the list of blocked signals.
   SigSetMask : Set the list of blocked signals to SSet
  if OldSSet is non-null, the old set will be saved there.
}
Var
  sr : SyscallRegs;
begin
  sr.reg2:=how;
  sr.reg3:=longint(SSet);
  sr.reg4:=longint(OldSSet);
  SysCall(Syscall_nr_sigprocmask,sr);
  linuxerror:=errno;
end;



Function SigPending:SigSet;
{
  Allows examination of pending signals. The signal mask of pending
  signals is set in SSet
}
Var
  sr    : SyscallRegs;
  dummy : Sigset;
begin
  sr.reg2:=longint(@dummy);
  SysCall(Syscall_nr_sigpending,sr);
  linuxerror:=errno;
  Sigpending:=dummy;
end;



Procedure SigSuspend(Mask:Sigset);
{
 Set the signal mask with Mask, and suspend the program until a signal
 is received.
}
Var
  sr : SyscallRegs;
begin
  sr.reg2:=mask;
  SysCall(Syscall_nr_sigsuspend,sr);
  linuxerror:=errno;
end;



Function Signal(Signum:Integer;Handler:PSignalHandler):PSignalHandler;
{
  Install a new handler for signal Signum.
  The old signal handler is returned.
  This call does, in fact, the same as SigAction.
}
var
  sr : Syscallregs;
begin
  sr.reg2:=signum;
  sr.reg3:=longint(handler);
  Linuxerror:=SysCall(Syscall_nr_signal,sr);
  If linuxerror=Sig_Err then
   begin
     Signal:=nil;
     Linuxerror:=errno;
   end
  else
   begin
     Signal:=pointer(Linuxerror);
     linuxerror:=0;
   end;
end;


{******************************************************************************
                         IOCtl and Termios calls
******************************************************************************}

Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean;
{
  Interface to Unix ioctl call.
  Performs various operations on the filedescriptor Handle.
  Ndx describes the operation to perform.
  Data points to data needed for the Ndx function. The structure of this
  data is function-dependent.
}
var
  sr: SysCallRegs;
begin
  sr.reg2:=Handle;
  sr.reg3:=Ndx;
  sr.reg4:=Longint(Data);
  IOCtl:=(SysCall(Syscall_nr_ioctl,sr)=0);
  LinuxError:=Errno;
end;



Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
begin
  TCGetAttr:=IOCtl(fd,TCGETS,@tios);
end;



Function TCSetAttr(fd:longint;OptAct:longint;var tios:TermIOS):boolean;
var
  nr:longint;
begin
  case OptAct of
   TCSANOW   : nr:=TCSETS;
   TCSADRAIN : nr:=TCSETSW;
   TCSAFLUSH : nr:=TCSETSF;
  else
   begin
     ErrNo:=Sys_EINVAL;
     TCSetAttr:=false;
     exit;
   end;
  end;
  TCSetAttr:=IOCtl(fd,nr,@Tios);
end;



Procedure CFSetISpeed(var tios:TermIOS;speed:Longint);
begin
  tios.c_cflag:=(tios.c_cflag and (not CBAUD)) or speed;
end;



Procedure CFSetOSpeed(var tios:TermIOS;speed:Longint);
begin
  CFSetISpeed(tios,speed);
end;



Procedure CFMakeRaw(var tios:TermIOS);
begin
  with tios do
   begin
     c_iflag:=c_iflag and (not (IGNBRK or BRKINT or PARMRK or ISTRIP or 
                                INLCR or IGNCR or ICRNL or IXON));
     c_oflag:=c_oflag and (not OPOST);
     c_lflag:=c_lflag and (not (ECHO or ECHONL or ICANON or ISIG or IEXTEN));
     c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or CS8;
   end;    
end;



Function TCSendBreak(fd,duration:longint):boolean;
begin
  TCSendBreak:=IOCtl(fd,TCSBRK,pointer(duration));
end;



Function TCSetPGrp(fd,id:longint):boolean;
begin
  TCSetPGrp:=IOCtl(fd,TIOCSPGRP,pointer(id));
end;



Function TCGetPGrp(fd:longint;var id:longint):boolean;
begin
  TCGetPGrp:=IOCtl(fd,TIOCGPGRP,@id);
end;



Function TCDrain(fd:longint):boolean;
begin
  TCDrain:=IOCtl(fd,TCSBRK,pointer(1));
end;



Function TCFlow(fd,act:longint):boolean;
begin
  TCFlow:=IOCtl(fd,TCXONC,pointer(act));
end;



Function TCFlush(fd,qsel:longint):boolean;
begin
  TCFlush:=IOCtl(fd,TCFLSH,pointer(qsel));
end;



Function IsATTY(Handle:Longint):Boolean;
{
  Check if the filehandle described by 'handle' is a TTY (Terminal)
}
var
  t : Termios;
begin
 IsAtty:=TCGetAttr(Handle,t);
end;



Function IsATTY(f: text):Boolean;
{
  Idem as previous, only now for text variables.
}
begin
  IsATTY:=IsaTTY(textrec(f).handle);
end;



function TTYName(Handle:Longint):string;
{
  Return the name of the current tty described by handle f.
  returns empty string in case of an error.
}
Const
  dev='/dev';
var
  name      : string;
  st        : stat;
  mydev,
  myino     : longint;
  dirstream : pdir;
  d         : pdirent;
begin
  TTYName:='';
  fstat(handle,st);
  if (errno<>0) and isatty (handle) then
   exit;
  mydev:=st.dev;
  myino:=st.ino;
  dirstream:=opendir(dev);
  if (linuxerror<>0) then
   exit;
  d:=Readdir(dirstream);
  while (d<>nil) do
   begin
     if (d^.ino=myino) then
      begin
        name:=dev+'/'+strpas(@(d^.name));
        fstat(name,st);
        if (linuxerror=0) and (st.dev=mydev) then
         begin
           closedir(dirstream);
           ttyname:=name;
           exit;
         end;
      end;
     d:=Readdir(dirstream);
   end;
  closedir(dirstream);
end;



function TTYName(var F:Text):string;
{
  Idem as previous, only now for text variables;
}
begin
  TTYName:=TTYName(textrec(f).handle);
end;



{******************************************************************************
                             Utility calls
******************************************************************************}

Function Octal(l:longint):longint;
{
  Convert an octal specified number to decimal;
}
var
  octnr,
  oct : longint;
begin
  octnr:=0;
  oct:=0;
  while (l>0) do
   begin
     oct:=oct or ((l mod 10) shl octnr);
     l:=l div 10;
     inc(octnr,3);
   end;
  Octal:=oct;
end;



Function StringToPPChar(Var S:STring):ppchar;
{
  Create a PPChar to structure of pchars which are the arguments specified
  in the string S. Especially usefull for creating an ArgV for Exec-calls
}
var
  nr  : longint;
  Buf : ^char;
  p   : ppchar;
begin
  s:=s+#0;
  buf:=@s[1];
  nr:=0;
  while(buf^<>#0) do
   begin
     while (buf^ in [' ',#8,#10]) do
      buf:=buf+1;
     inc(nr);
     while not (buf^ in [' ',#0,#8,#10]) do
      buf:=buf+1;
   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;
        buf:=buf+1;
      end;
     p^:=buf;
     p:=p+4;
     p^:=nil;
     while not (buf^ in [' ',#0,#8,#10]) do
      buf:=buf+1;
   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
      getdir(0,temp)
     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 . and / which may exist}
  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,Name,Ext : string;
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,Name,Ext : string;
begin
  FSplit(Path,Dir,Name,Ext);
  if Suf<>Ext then
   Name:=Name+Ext;
  BaseName:=Name;
end;



Function FNMatch(const Pattern,Name:string):Boolean;

Var
  LenPat,LenName : longint;

  Function DoFNMatch(i,j:longint):Boolean;
  Var
    Found : boolean;
  Begin
  Found:=true;
  While Found and (i<=LenPat) Do
   Begin
     Case Pattern[i] of
      '?' : Found:=(j<=LenName);
      '*' : Begin
            {find the next character in pattern, different of ? and *}
              while Found and (i<LenPat) do
                begin
                inc(i);
                case Pattern[i] of
                  '*' : ;
                  '?' : begin
                          inc(j);
                          Found:=(j<=LenName);
                        end;
                else
                  Found:=false;
                end;
               end;
            {Now, find in name the character which i points to, if the * or ?
             wasn't the last character in the pattern, else, use up all the
             chars in name}
              Found:=true;
              if (i<=LenPat) then
                begin
                repeat
                {find a letter (not only first !) which maches pattern[i]}
                while (j<=LenName) and (name[j]<>pattern[i]) do
                  inc (j);
                 if (j<LenName) then
                  begin
                    if DoFnMatch(i+1,j+1) then
                     begin
                       i:=LenPat;
                       j:=LenName;{we can stop}
                       Found:=true;
                     end
                    else
                     inc(j);{We didn't find one, need to look further}
                  end;
               until (j>=LenName);
                end
              else
                j:=LenName;{we can stop}
            end;
     else {not a wildcard character in pattern}
       Found:=(j<=LenName) and (pattern[i]=name[j]);
     end;
     inc(i);
     inc(j);
   end;
  DoFnMatch:=Found and (j>LenName);
  end;

Begin {start FNMatch}
  LenPat:=Length(Pattern);
  LenName:=Length(Name);
  FNMatch:=DoFNMatch(1,1);
End;



Procedure Globfree(var p : pglob);
{
  Release memory occupied by pglob structure, and names in it.
  sets p to nil.
}
var
  temp : pglob;
begin
  while p<>nil do
   begin
     temp:=p^.next;
     if p^.name<>nil then
      freemem(p^.name,strlen(p^.name));
     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);
  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:integer):boolean;
{
  Check mode field of inode for link.
}
begin
  S_ISLNK:=(m and STAT_IFMT)=STAT_IFLNK;
end;



Function S_ISREG(m:integer):boolean;
{
  Check mode field of inode for regular file.
}
begin
  S_ISREG:=(m and STAT_IFMT)=STAT_IFREG;
end;



Function S_ISDIR(m:integer):boolean;   
{
  Check mode field of inode for directory.
}
begin
  S_ISDIR:=(m and STAT_IFMT)=STAT_IFDIR;
end;



Function S_ISCHR(m:integer):boolean;
{
  Check mode field of inode for character device.
}
begin
  S_ISCHR:=(m and STAT_IFMT)=STAT_IFCHR;
end;



Function S_ISBLK(m:integer):boolean;
{
  Check mode field of inode for block device.
}
begin
  S_ISBLK:=(m and STAT_IFMT)=STAT_IFBLK;
end;



Function S_ISFIFO(m:integer):boolean;
{
  Check mode field of inode for named pipe (FIFO).
}
begin
  S_ISFIFO:=(m and STAT_IFMT)=STAT_IFIFO;
end;



Function S_ISSOCK(m:integer):boolean;
{
  Check mode field of inode for socket.
}
begin
  S_ISSOCK:=(m and STAT_IFMT)=STAT_IFSOCK;
end;


Begin
  InitEpochToLocal;
End.

{
  $Log$
  Revision 1.4  1998-04-07 13:08:29  michael
  + Added flock for file locking


  Revision 1.3  1998/04/07 12:27:41  peter
    * fixed fexpand('..')

  Revision 1.2  1998/04/04 17:07:17  michael
  + Fixed AssignStream, it completely refused to work

  Revision 1.1.1.1  1998/03/25 11:18:43  root
  * Restored version

  Revision 1.17  1998/02/23 14:17:51  michael
  * Fixed pclose bug. Programs went into a neverending loop.

  Revision 1.16  1998/02/08 01:58:11  peter
    + Overloaded functions Dup/Dup2 for longint,file
    * Better Pipe support
    * Some cleanup

  Revision 1.15  1998/01/26 12:01:18  michael
  + Added log at the end

  revision 1.14
  date: 1998/01/19 10:03:01; author: michael; state: Exp; lines: +2 -2
  * BugFix for findfirst/findnext routines. (From Peter Vreman)
  ----------------------------
  revision 1.13
  date: 1998/01/16 00:02:57; author: michael; state: Exp; lines: +25 -9
  FExpand expands ~/ to HOME (Fro Peter Vreman)
  ----------------------------
  revision 1.12
  date: 1998/01/13 17:14:38; author: michael; state: Exp; lines: +23 -1
  + Entered new FStat call using File or Text var.
  + GetTme call in DOS now refers to Linux.gettime !
  ----------------------------
  revision 1.11
  date: 1998/01/11 02:49:36; author: michael; state: Exp; lines: +29 -19
  + Fixed bugs discoverd when writing examples, changed procedure to
    function : boolean in some cases.
  ----------------------------
  revision 1.10
  date: 1998/01/08 00:18:13; author: michael; state: Exp; lines: +17 -7
  * Made Dup,Dup2 functions retuning Boolean;
  * Name in Dirent is now Array [0..255] of char instead of string.
  + Implemented OpenDir with string as path, instead of pchar.
  ----------------------------
  revision 1.9
  date: 1998/01/06 15:04:50; author: michael; state: Exp; lines: +5 -5
  * Some boolean functions had an undefined result. Fixed that.
  ----------------------------
  revision 1.8
  date: 1998/01/05 16:43:19; author: michael; state: Exp; lines: +19 -5
  * Nicer implementation of GetDate and GetTime, using a newly implemented
    GetTimeOfDay function (overloaded). (From Peter Vreman)
  ----------------------------
  revision 1.7
  date: 1997/12/22 18:50:31; author: michael; state: Exp; lines: +8 -5
  * Bug fixed in fexpand, extra / was sometimes added for filename
  * fdsets are treated correctly now.
  ----------------------------
  revision 1.6
  date: 1997/12/19 15:23:02; author: michael; state: Exp; lines: +9 -9
  * changed some termios functions to procedures.
  ----------------------------
  revision 1.5
  date: 1997/12/15 12:56:19; author: michael; state: Exp; lines: +4 -4
  * fixed bug in fdset handling functions.
  ----------------------------
  revision 1.4
  date: 1997/12/10 13:32:43; author: michael; state: Exp; lines: +558 -326
  + added termios functies
  * epochtolocal geeft nu tijd in Local time...
  ----------------------------
  revision 1.3
  date: 1997/12/04 13:43:51; author: michael; state: Exp; lines: +61 -73
  * changed attribute and time functions.
  ----------------------------
  revision 1.2
  date: 1997/12/01 12:31:15; author: michael; state: Exp; lines: +15 -22
  + Added copyright reference in header.
  ----------------------------
  revision 1.1
  date: 1997/11/27 08:33:54; author: michael; state: Exp;
  Initial revision
  ----------------------------
  revision 1.1.1.1
  date: 1997/11/27 08:33:54; author: michael; state: Exp; lines: +0 -0
  FPC RTL CVS start
  =============================================================================

   Date          Version          Who         Comments
   96/97         0.8              Michael     Initial implementation
                                              Code cleanup
   11/97         0.9              Peter       <[email protected]>
                                              Code cleanup, added
                                              some calls
  ---------------------------------------------------------------------
}