fpc/rtl/unix/bunxovl.inc

{
    This file is part of the Free Pascal run time library.
    Copyright (c) 2002 by Marco van de Voort

    Some generic overloads for stringfunctions in the baseunix unit.

    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.

 **********************************************************************}

Function  FpLink (const existing : RawByteString; const newone : RawByteString): cInt; {$ifdef VER2_0}inline;{$endif}
var
  SystemExistingFileName, SystemNewOneFileName: RawByteString;
Begin
  SystemExistingFileName:=ToSingleByteFileSystemEncodedFileName(existing);
  SystemNewOneFileName:=ToSingleByteFileSystemEncodedFileName(newone);
  FpLink:=FpLink(PAnsiChar(SystemExistingFileName),PAnsiChar(SystemNewOneFileName));
End;

Function  FpMkfifo (const path : RawByteString; Mode : TMode): cInt; {$ifdef VER2_0}inline;{$endif}
var
  SystemPath: RawByteString;
Begin
  SystemPath:=ToSingleByteFileSystemEncodedFileName(path);
  FpMkfifo:=FpMkfifo(PAnsiChar(SystemPath),mode);
End;

Function  FpChmod (const path : RawByteString; Mode : TMode): cInt; {$ifdef VER2_0}inline;{$endif}
var
  SystemPath: RawByteString;
Begin
  SystemPath:=ToSingleByteFileSystemEncodedFileName(path);
  FpChmod:=FpChmod(PAnsiChar(SystemPath),mode);
End;

Function  FpChown (const path : RawByteString; owner : TUid; group : TGid): cInt;{$ifdef VER2_0}inline;{$endif}
var
  SystemPath: RawByteString;
Begin
  SystemPath:=ToSingleByteFileSystemEncodedFileName(path);
  FpChown:=FpChown(PAnsiChar(SystemPath),owner,group);
End;

Function  FpUtime (const path : RawByteString; times : putimbuf): cInt; {$ifdef VER2_0}inline;{$endif}
var
  SystemPath: RawByteString;
Begin
  SystemPath:=ToSingleByteFileSystemEncodedFileName(path);
  FpUtime:=FpUtime(PAnsiChar(SystemPath),times);
End;

{
Function  FpGetcwd (const path:RawByteString; siz:TSize):RawByteString; {$ifdef VER2_0}inline;{$endif}
var
  SystemPath: RawByteString;
Begin
  SystemPath:=ToSingleByteFileSystemEncodedFileName(path);
  FpGetcwd:=RawByteString(PAnsiChar(FpGetcwd(PAnsiChar(SystemPath),siz)));
  SetCodePage(FpGetcwd,DefaultFileSystemCodePage,false);
End;
}
Function  FpGetcwd: RawByteString;

Var
  Buf : Array[0..PATH_MAX+1]  of AnsiChar;
Begin
  Buf[PATH_MAX+1]:=#0;
  If FpGetcwd(@Buf[0],PATH_MAX)=Nil then
    FpGetcwd:=''
  else
    begin
      FpGetcwd:=Buf;
      SetCodePage(FpGetcwd,DefaultFileSystemCodePage,false);
    end;
End;

Function  FpExecve (const path : RawByteString; argv : PPAnsiChar; envp: PPAnsiChar): cInt; {$ifdef VER2_0}inline;{$endif}
var
  SystemPath: RawByteString;
Begin
  SystemPath:=ToSingleByteFileSystemEncodedFileName(path);
  FpExecve:=FpExecve (PAnsiChar(SystemPath),argv,envp);
End;

Function  FpExecv (const path : RawByteString; argv : PPAnsiChar): cInt; {$ifdef VER2_0}inline;{$endif}
var
  SystemPath: RawByteString;
Begin
  SystemPath:=ToSingleByteFileSystemEncodedFileName(path);
  FpExecv:=FpExecve (PAnsiChar(SystemPath),argv,envp);
End;


Function  FpChdir (const path : RawByteString): cInt; {$ifdef VER2_0}inline;{$endif}
var
  SystemPath: RawByteString;
Begin
  SystemPath:=ToSingleByteFileSystemEncodedFileName(path);
  FpChDir:=FpChdir(PAnsiChar(SystemPath));
End;

Function  FpOpen (const path : RawByteString; flags : cInt; Mode: TMode):cInt; {$ifdef VER2_0}inline;{$endif}
var
  SystemPath: RawByteString;
Begin
  SystemPath:=ToSingleByteFileSystemEncodedFileName(path);
  FpOpen:=FpOpen(PAnsiChar(SystemPath),flags,mode);
End;


Function  FpMkdir (const path : RawByteString; Mode: TMode):cInt; {$ifdef VER2_0}inline;{$endif}
var
  SystemPath: RawByteString;
Begin
  SystemPath:=ToSingleByteFileSystemEncodedFileName(path);
  FpMkdir:=FpMkdir(PAnsiChar(SystemPath),mode);
End;

Function  FpUnlink (const path : RawByteString): cInt; {$ifdef VER2_0}inline;{$endif}
var
  SystemPath: RawByteString;
Begin
  SystemPath:=ToSingleByteFileSystemEncodedFileName(path);
  FpUnlink:=FpUnlink(PAnsiChar(SystemPath));
End;

Function  FpRmdir (const path : RawByteString): cInt; {$ifdef VER2_0}inline;{$endif}
var
  SystemPath: RawByteString;
Begin
  SystemPath:=ToSingleByteFileSystemEncodedFileName(path);
  FpRmdir:=FpRmdir(PAnsiChar(SystemPath));
End;

Function  FpRename (const old  : RawByteString; const newpath: RawByteString): cInt; {$ifdef VER2_0}inline;{$endif}
var
  OldSystemPath, NewSystemPath: RawByteString;
Begin
  OldSystemPath:=ToSingleByteFileSystemEncodedFileName(old);
  NewSystemPath:=ToSingleByteFileSystemEncodedFileName(newpath);
  FpRename:=FpRename(PAnsiChar(OldSystemPath),PAnsiChar(NewSystemPath));
End;

Function  FpStat (const path: RawByteString; var buf : stat): cInt; {$ifdef VER2_0}inline;{$endif}
var
  SystemPath: RawByteString;
Begin
  SystemPath:=ToSingleByteFileSystemEncodedFileName(path);
  FpStat:=FpStat(PAnsiChar(SystemPath),buf);
End;

Function  fpLstat   (const path: RawByteString; Info: pstat):cint; inline;
var
  SystemPath: RawByteString;
Begin
  SystemPath:=ToSingleByteFileSystemEncodedFileName(path);
  fplstat:=fplstat(PAnsiChar(SystemPath), info);
end;

Function  fpLstat   (path:PAnsiChar;var Info:stat):cint; inline;

begin
  fpLstat:=fplstat(path,@info);
end;

Function  fpLstat   (const Filename: RawByteString;var Info:stat):cint; inline;
Begin
  fpLstat:=fplstat(filename,@info);
end;

Function FpAccess (const pathname : RawByteString; aMode : cInt): cInt; {$ifdef VER2_0}inline;{$endif}
var
  SystemPathName: RawByteString;
Begin
  SystemPathName:=ToSingleByteFileSystemEncodedFileName(pathname);
  FpAccess:=FpAccess(PAnsiChar(SystemPathName),amode);
End;

Function  FPFStat(var F:Text;Var Info:stat):Boolean; {$ifdef VER2_0}inline;{$endif}
{
  Get all information on a text file, and return it in info.
}
begin
  FPFStat:=FPFstat(TextRec(F).Handle,INfo)=0;
end;

Function  FPFStat(var F:File;Var Info:stat):Boolean; {$ifdef VER2_0}inline;{$endif}
{
  Get all information on a untyped file, and return it in info.
}
begin
  FPFStat:=FPFstat(FileRec(F).Handle,Info)=0;
end;

Function FpSignal(signum:longint;Handler:signalhandler):signalhandler;
// should be moved out of generic files. Too specific.

var sa,osa : sigactionrec;

begin
     sa.sa_handler:=SigActionHandler(handler);
     FillChar(sa.sa_mask,sizeof(sa.sa_mask),#0);
     sa.sa_flags := 0;
{     if (sigintr and signum) =0 then
 {restart behaviour needs libc}
      sa.sa_flags :=sa.sa_flags or SA_RESTART;
}
     FPSigaction(signum,@sa,@osa);
     if fpgetErrNo<>0 then
       fpsignal:=NIL
     else
       fpsignal:=signalhandler(osa.sa_handler);
end;

{$ifdef FPC_USE_LIBC} // can't remember why this is the case. Might be legacy.
function xFpread(fd: cint; buf: PAnsiChar; nbytes : size_t): ssize_t; cdecl; external clib name 'read';
{$else}
function xFpread(fd: cint; buf: PAnsiChar; nbytes : size_t): ssize_t; external name 'FPC_SYSC_READ';
{$endif}

Function  FpRead           (fd : cInt;var buf; nbytes : TSize): TSsize; {$ifdef VER2_0}inline;{$endif}

begin
  FPRead:=xFpRead(fd,PAnsiChar(@buf),nbytes);
end;

Function  FpWrite          (fd : cInt;const buf; nbytes : TSize): TSsize; {$ifdef VER2_0}inline;{$endif}
begin
 FpWrite:=FpWrite(fd,PAnsiChar(@buf),nbytes);
end;

{$ifdef linux}
function  FppRead           (fd : cInt;var buf; nbytes : TSize; offset:Toff): TSsize; {$ifdef VER2_0}inline;{$endif}

begin
  FppRead:=FppRead(fd,PAnsiChar(@buf),nbytes,offset);
end;

function  FppWrite          (fd : cInt;const buf; nbytes : TSize; offset:Toff): TSsize; {$ifdef VER2_0}inline;{$endif}

begin
  FppWrite:=FppWrite(fd,PAnsiChar(@buf),nbytes,offset);
end;
{$endif}

const
  { read/write permission for everyone }
  MODE_FPOPEN = S_IWUSR OR S_IRUSR OR
                S_IWGRP OR S_IRGRP OR
                S_IWOTH OR S_IROTH;

Function  FpOpen    (path : PAnsiChar; flags : cInt):cInt; {$ifdef VER2_0}inline;{$endif}

begin
 FpOpen:=FpOpen(path,flags,MODE_FPOPEN);
end;

Function  FpOpen    (const path : RawByteString; flags : cInt):cInt; {$ifdef VER2_0}inline;{$endif}
var
  SystemPath: RawByteString;
Begin
  SystemPath:=ToSingleByteFileSystemEncodedFileName(path);
  FpOpen:=FpOpen(PAnsiChar(SystemPath),flags,MODE_FPOPEN);
end;

Function  FpOpen    (path : ShortString; flags : cInt):cInt;

begin
 path:=path+#0;
 FpOpen:=FpOpen(@path[1],flags,MODE_FPOPEN);
end;

Function  FpOpen    (path : ShortString; flags : cInt; Mode: TMode):cInt;

begin
 path:=path+#0;
 FpOpen:=FpOpen(@path[1],flags,Mode);
end;

Function  FpOpendir (const dirname : RawByteString): pDir; {$ifdef VER2_0}inline;{$endif}
var
  SystemDirName: RawByteString;
Begin
  SystemDirName:=ToSingleByteFileSystemEncodedFileName(dirname);
  FpOpenDir:=FpOpenDir(PAnsiChar(SystemDirName));
End;


Function  FpOpendir (dirname : shortString): pDir; {$ifdef VER2_0}inline;{$endif}
Begin
  dirname:=dirname+#0;
  FpOpenDir:=FpOpenDir(PAnsiChar(@dirname[1]));
End;


Function  FpStat (path: ShortString; var buf : stat): cInt;

begin
 path:=path+#0;
 FpStat:=FpStat(PAnsiChar(@path[1]),buf);
end;

Function fpDup(var oldfile,newfile:text):cint;
{
  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. }
  textrec(newfile).handle:=fpDup(textrec(oldfile).handle);
  fpdup:=textrec(newfile).handle;
end;

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


Function FpDup2(var oldfile,newfile:text):cint;
{
  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. }
  fpDup2:=fpDup2(textrec(oldfile).handle,textrec(newfile).handle);
end;

Function FpDup2(var oldfile,newfile:file):cint;
{
  Copies the filedescriptor oldfile to newfile
}
var
  tmphandle : word;
begin
  tmphandle := filerec(newfile).handle;
  filerec(newfile):=filerec(oldfile);
  filerec(newfile).handle := tmphandle;
  fpDup2:=fpDup2(filerec(oldfile).handle,filerec(newfile).handle);
end;

function  fptime    :time_t;  {$ifdef VER2_0}inline;{$endif}
var t:time_t;
begin
  fptime:=fptime(t);
end;

Function fpSelect(N:cint;readfds,writefds,exceptfds:pfdset;TimeOut:cint):cint;
{
  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.tv_Sec:=Timeout div 1000;
     tv.tv_Usec:=(Timeout mod 1000)*1000;
     p:=@tv;
   end;
  fpSelect:=fpSelect(N,Readfds,WriteFds,ExceptFds,p);
end;

Function fpSelect(var T:Text;TimeOut :PTimeval):cint;
Var
  F:TfdSet;
begin
  if textrec(t).mode=fmclosed then
   begin
     fpSetErrNo(ESysEBADF);
     exit(-1);
   end;
  FpFD_ZERO(f);
  fpFD_SET(textrec(T).handle,f);
  if textrec(T).mode=fminput then
   fpselect:=fpselect(textrec(T).handle+1,@f,nil,nil,TimeOut)
  else
   fpSelect:=fpselect(textrec(T).handle+1,nil,@f,nil,TimeOut);
end;

Function fpSelect(var T:Text;TimeOut :time_t):cint;
var
  p  : PTimeVal;
  tv : TimeVal;
begin
  if TimeOut=-1 then
   p:=nil
  else
   begin
     tv.tv_Sec:=Timeout div 1000;
     tv.tv_Usec:=(Timeout mod 1000)*1000;
     p:=@tv;
   end;
  fpSelect:=fpSelect(T,p);
end;

function  FpWaitPid (pid : TPid; Var Status : cInt; Options : cint) : TPid;

begin
  fpWaitPID:=fpWaitPID(Pid,@Status,Options);
end;

Function fpReadLink(const Name: RawByteString): RawByteString;
{
  Read a link (where it points to)
}
var
  SystemFileName : RawByteString;
  i : cint;
begin
  SetLength(fpReadLink,PATH_MAX);
  SystemFileName:=ToSingleByteFileSystemEncodedFileName(Name);
  i:=fpReadLink(PAnsiChar(SystemFileName),PAnsiChar(fpReadLink),PATH_MAX);
  if i>0 then
   begin
     SetLength(fpReadLink,i);
     SetCodePage(fpReadLink,DefaultFileSystemCodePage,false);
   end
  else
    fpReadLink:='';
end;