mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 04:22:07 +01:00
461 lines
13 KiB
PHP
461 lines
13 KiB
PHP
{
|
|
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;
|
|
|
|
|