123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068 |
- {
- This file is part of the Free Pascal run time library.
- Copyright (c) 1999-2000 by Florian Klaempfl
- member of the Free Pascal development team
- Sysutils unit for linux
- 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 sysutils;
- interface
- {$MODE objfpc}
- { force ansistrings }
- {$H+}
- {$if (defined(BSD) or defined(SUNOS)) and defined(FPC_USE_LIBC)}
- {$define USE_VFORK}
- {$endif}
- {$DEFINE OS_FILESETDATEBYNAME}
- {$DEFINE HAS_SLEEP}
- {$DEFINE HAS_OSERROR}
- {$DEFINE HAS_OSCONFIG}
- {$DEFINE HAS_TEMPDIR}
- {$DEFINE HASUNIX}
- {$DEFINE HASCREATEGUID}
- uses
- Unix,errors,sysconst,Unixtype;
- { Include platform independent interface part }
- {$i sysutilh.inc}
- Function AddDisk(const path:string) : Byte;
- { the following is Kylix compatibility stuff, it should be moved to a
- special compatibilty unit (FK) }
- const
- RTL_SIGINT = 0;
- RTL_SIGFPE = 1;
- RTL_SIGSEGV = 2;
- RTL_SIGILL = 3;
- RTL_SIGBUS = 4;
- RTL_SIGQUIT = 5;
- RTL_SIGLAST = RTL_SIGQUIT;
- RTL_SIGDEFAULT = -1;
- type
- TSignalState = (ssNotHooked, ssHooked, ssOverridden);
- function InquireSignal(RtlSigNum: Integer): TSignalState;
- procedure AbandonSignalHandler(RtlSigNum: Integer);
- procedure HookSignal(RtlSigNum: Integer);
- procedure UnhookSignal(RtlSigNum: Integer; OnlyIfHooked: Boolean = True);
- implementation
- Uses
- {$ifdef FPC_USE_LIBC}initc{$ELSE}Syscall{$ENDIF}, Baseunix, unixutil;
- function InquireSignal(RtlSigNum: Integer): TSignalState;
- begin
- end;
- procedure AbandonSignalHandler(RtlSigNum: Integer);
- begin
- end;
- procedure HookSignal(RtlSigNum: Integer);
- begin
- end;
- procedure UnhookSignal(RtlSigNum: Integer; OnlyIfHooked: Boolean = True);
- begin
- end;
- {$Define OS_FILEISREADONLY} // Specific implementation for Unix.
- {$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
- {$DEFINE FPC_FEXPAND_GETENVPCHAR} { GetEnv result is a PChar }
- { Include platform independent implementation part }
- {$i sysutils.inc}
- { Include SysCreateGUID function }
- {$i suuid.inc}
- Const
- {Date Translation}
- C1970=2440588;
- D0 = 1461;
- D1 = 146097;
- D2 =1721119;
- Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
- Var
- YYear,XYear,Temp,TempMonth : LongInt;
- Begin
- Temp:=((JulianDN-D2) shl 2)-1;
- JulianDN:=Temp Div D1;
- XYear:=(Temp Mod D1) or 3;
- YYear:=(XYear Div D0);
- Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
- Day:=((Temp Mod 153)+5) Div 5;
- TempMonth:=Temp Div 153;
- If TempMonth>=10 Then
- Begin
- inc(YYear);
- dec(TempMonth,12);
- End;
- inc(TempMonth,3);
- Month := TempMonth;
- Year:=YYear+(JulianDN*100);
- end;
- Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
- {
- Transforms Epoch time into local time (hour, minute,seconds)
- }
- Var
- DateNum: LongInt;
- Begin
- inc(Epoch,TZSeconds);
- Datenum:=(Epoch Div 86400) + c1970;
- JulianToGregorian(DateNum,Year,Month,day);
- Epoch:=Abs(Epoch Mod 86400);
- Hour:=Epoch Div 3600;
- Epoch:=Epoch Mod 3600;
- Minute:=Epoch Div 60;
- Second:=Epoch Mod 60;
- End;
- {****************************************************************************
- File Functions
- ****************************************************************************}
- 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
- begin
- DotPos:=i;
- end;
- 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 FileOpen (Const FileName : string; Mode : Integer) : Longint;
- Var LinuxFlags : longint;
- BEGIN
- LinuxFlags:=0;
- Case (Mode and 3) of
- 0 : LinuxFlags:=LinuxFlags or O_RdOnly;
- 1 : LinuxFlags:=LinuxFlags or O_WrOnly;
- 2 : LinuxFlags:=LinuxFlags or O_RdWr;
- end;
- FileOpen:=fpOpen (FileName,LinuxFlags);
- //!! We need to set locking based on Mode !!
- end;
- Function FileCreate (Const FileName : String) : Longint;
- begin
- FileCreate:=fpOpen(FileName,O_RdWr or O_Creat or O_Trunc);
- end;
- Function FileCreate (Const FileName : String;Mode : Longint) : Longint;
- BEGIN
- FileCreate:=fpOpen(FileName,O_RdWr or O_Creat or O_Trunc,Mode);
- end;
- Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
- begin
- FileRead:=fpRead (Handle,Buffer,Count);
- end;
- Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
- begin
- FileWrite:=fpWrite (Handle,Buffer,Count);
- end;
- Function FileSeek (Handle,FOffset,Origin : Longint) : Longint;
- begin
- result:=longint(FileSeek(Handle,int64(FOffset),Origin));
- end;
- Function FileSeek (Handle : Longint; FOffset : Int64; Origin : Longint) : Int64;
- begin
- FileSeek:=fplSeek (Handle,FOffset,Origin);
- end;
- Procedure FileClose (Handle : Longint);
- begin
- fpclose(Handle);
- end;
- Function FileTruncate (Handle,Size: Longint) : boolean;
- begin
- FileTruncate:=fpftruncate(Handle,Size)>=0;
- end;
- Function UnixToWinAge(UnixAge : time_t): Longint;
- Var
- Y,M,D,hh,mm,ss : word;
- begin
- EpochToLocal(UnixAge,y,m,d,hh,mm,ss);
- Result:=DateTimeToFileDate(EncodeDate(y,m,d)+EncodeTime(hh,mm,ss,0));
- end;
- Function FileAge (Const FileName : String): Longint;
- Var Info : Stat;
- begin
- If fpstat (FileName,Info)<0 then
- exit(-1)
- else
- Result:=UnixToWinAge(info.st_mtime);
- end;
- Function FileExists (Const FileName : String) : Boolean;
- begin
- // Don't use stat. It fails on files >2 GB.
- // Access obeys the same access rules, so the result should be the same.
- FileExists:=fpAccess(filename,F_OK)=0;
- end;
- Function DirectoryExists (Const Directory : String) : Boolean;
- Var Info : Stat;
- begin
- DirectoryExists:=(fpstat(Directory,Info)>=0) and fpS_ISDIR(Info.st_mode);
- end;
- Function LinuxToWinAttr (FN : Pchar; Const Info : Stat) : Longint;
- begin
- Result:=faArchive;
- If fpS_ISDIR(Info.st_mode) then
- Result:=Result or faDirectory;
- If (FN[0]='.') and (not (FN[1] in [#0,'.'])) then
- Result:=Result or faHidden;
- If (Info.st_Mode and S_IWUSR)=0 Then
- Result:=Result or faReadOnly;
- If fpS_ISSOCK(Info.st_mode) or fpS_ISBLK(Info.st_mode) or fpS_ISCHR(Info.st_mode) or fpS_ISFIFO(Info.st_mode) Then
- Result:=Result or faSysFile;
- If fpS_ISLNK(Info.st_mode) Then
- Result:=Result or faSymLink;
- 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 do
- begin
- inc(i);
- if i>LenPat then Break;
- case Pattern[i] of
- '*' : ;
- '?' : begin
- if j>LenName then begin DoFNMatch:=false; Exit; end;
- inc(j);
- end;
- else
- Found:=false;
- end;
- end;
- Assert((i>LenPat) or ( (Pattern[i]<>'*') and (Pattern[i]<>'?') ));
- {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:=false;
- 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;
- Break;
- end else
- inc(j);{We didn't find one, need to look further}
- end else
- if j=LenName then
- begin
- Found:=true;
- Break;
- end;
- { This 'until' condition must be j>LenName, not j>=LenName.
- That's because when we 'need to look further' and
- j = LenName then loop must not terminate. }
- until (j>LenName);
- end else
- begin
- j:=LenName;{we can stop}
- Found:=true;
- end;
- 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;
- Type
- TUnixFindData = Record
- NamePos : LongInt; {to track which search this is}
- DirPtr : Pointer; {directory pointer for reading directory}
- SearchSpec : String;
- SearchType : Byte; {0=normal, 1=open will close, 2=only 1 file}
- SearchAttr : Byte; {attribute we are searching for}
- End;
- PUnixFindData = ^TUnixFindData;
- Var
- CurrSearchNum : LongInt;
- Procedure FindClose(Var f: TSearchRec);
- var
- UnixFindData : PUnixFindData;
- Begin
- UnixFindData:=PUnixFindData(f.FindHandle);
- if UnixFindData=nil then
- exit;
- if UnixFindData^.SearchType=0 then
- begin
- if UnixFindData^.dirptr<>nil then
- fpclosedir(pdir(UnixFindData^.dirptr)^);
- end;
- Dispose(UnixFindData);
- f.FindHandle:=nil;
- End;
- Function FindGetFileInfo(const s:string;var f:TSearchRec):boolean;
- var
- st : baseunix.stat;
- WinAttr : longint;
- begin
- FindGetFileInfo:=false;
- if not fpstat(s,st)>=0 then
- exit;
- WinAttr:=LinuxToWinAttr(PChar(s),st);
- If (f.FindHandle = nil) or ((WinAttr and Not(PUnixFindData(f.FindHandle)^.searchattr))=0) Then
- Begin
- f.Name:=ExtractFileName(s);
- f.Attr:=WinAttr;
- f.Size:=st.st_Size;
- f.Mode:=st.st_mode;
- f.Time:=UnixToWinAge(st.st_mtime);
- result:=true;
- End;
- end;
- Function FindNext (Var Rslt : TSearchRec) : Longint;
- {
- re-opens dir if not already in array and calls FindWorkProc
- }
- Var
- DirName : String;
- i,
- ArrayPos : Longint;
- FName,
- SName : string;
- Found,
- Finished : boolean;
- p : pdirent;
- UnixFindData : PUnixFindData;
- Begin
- Result:=-1;
- UnixFindData:=PUnixFindData(Rslt.FindHandle);
- if UnixFindData=nil then
- exit;
- if (UnixFindData^.SearchType=0) and
- (UnixFindData^.Dirptr=nil) then
- begin
- If UnixFindData^.NamePos = 0 Then
- DirName:='./'
- Else
- DirName:=Copy(UnixFindData^.SearchSpec,1,UnixFindData^.NamePos);
- UnixFindData^.DirPtr := fpopendir(Pchar(DirName));
- end;
- SName:=Copy(UnixFindData^.SearchSpec,UnixFindData^.NamePos+1,Length(UnixFindData^.SearchSpec));
- Found:=False;
- Finished:=(UnixFindData^.dirptr=nil);
- While Not Finished Do
- Begin
- p:=fpreaddir(pdir(UnixFindData^.dirptr)^);
- if p=nil then
- FName:=''
- else
- FName:=p^.d_name;
- If FName='' Then
- Finished:=True
- Else
- Begin
- If FNMatch(SName,FName) Then
- Begin
- Found:=FindGetFileInfo(Copy(UnixFindData^.SearchSpec,1,UnixFindData^.NamePos)+FName,Rslt);
- if Found then
- begin
- Result:=0;
- exit;
- end;
- End;
- End;
- End;
- End;
- Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
- {
- opens dir and calls FindWorkProc
- }
- var
- UnixFindData : PUnixFindData;
- Begin
- Result:=-1;
- fillchar(Rslt,sizeof(Rslt),0);
- if Path='' then
- exit;
- {Wildcards?}
- if (Pos('?',Path)=0) and (Pos('*',Path)=0) then
- begin
- if FindGetFileInfo(Path,Rslt) then
- Result:=0;
- end
- else
- begin
- { Allocate UnixFindData }
- New(UnixFindData);
- FillChar(UnixFindData^,sizeof(UnixFindData^),0);
- Rslt.FindHandle:=UnixFindData;
- {Create Info}
- UnixFindData^.SearchSpec := Path;
- {We always also search for readonly and archive, regardless of Attr:}
- UnixFindData^.SearchAttr := Attr or faarchive or fareadonly;
- UnixFindData^.NamePos := Length(UnixFindData^.SearchSpec);
- while (UnixFindData^.NamePos>0) and (UnixFindData^.SearchSpec[UnixFindData^.NamePos]<>'/') do
- dec(UnixFindData^.NamePos);
- Result:=FindNext(Rslt);
- end;
- End;
- Function FileGetDate (Handle : Longint) : Longint;
- Var Info : Stat;
- begin
- If (fpFStat(Handle,Info))<0 then
- Result:=-1
- else
- Result:=Info.st_Mtime;
- end;
- Function FileSetDate (Handle,Age : Longint) : Longint;
- begin
- // Impossible under Linux from FileHandle !!
- FileSetDate:=-1;
- end;
- Function FileGetAttr (Const FileName : String) : Longint;
- Var Info : Stat;
- begin
- If FpStat (FileName,Info)<0 then
- Result:=-1
- Else
- Result:=LinuxToWinAttr(Pchar(ExtractFileName(FileName)),Info);
- end;
- Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
- begin
- Result:=-1;
- end;
- Function DeleteFile (Const FileName : String) : Boolean;
- begin
- Result:=fpUnLink (FileName)>=0;
- end;
- Function RenameFile (Const OldName, NewName : String) : Boolean;
- begin
- RenameFile:=BaseUnix.FpRename(OldNAme,NewName)>=0;
- end;
- Function FileIsReadOnly(const FileName: String): Boolean;
- begin
- Result := fpAccess(PChar(FileName),W_OK)<>0;
- end;
- Function FileSetDate (Const FileName : String;Age : Longint) : Longint;
- var
- t: TUTimBuf;
- begin
- Result := 0;
- t.actime := Age;
- t.modtime := Age;
- if fputime(PChar(FileName), @t) = -1 then
- Result := fpgeterrno;
- end;
- {****************************************************************************
- Disk Functions
- ****************************************************************************}
- {
- The Diskfree and Disksize functions need a file on the specified drive, since this
- is required for the statfs system call.
- These filenames are set in drivestr[0..26], and have been preset to :
- 0 - '.' (default drive - hence current dir is ok.)
- 1 - '/fd0/.' (floppy drive 1 - should be adapted to local system )
- 2 - '/fd1/.' (floppy drive 2 - should be adapted to local system )
- 3 - '/' (C: equivalent of dos is the root partition)
- 4..26 (can be set by you're own applications)
- ! Use AddDisk() to Add new drives !
- They both return -1 when a failure occurs.
- }
- Const
- FixDriveStr : array[0..3] of pchar=(
- '.',
- '/fd0/.',
- '/fd1/.',
- '/.'
- );
- var
- Drives : byte;
- DriveStr : array[4..26] of pchar;
- Function AddDisk(const path:string) : Byte;
- begin
- if not (DriveStr[Drives]=nil) then
- FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
- GetMem(DriveStr[Drives],length(Path)+1);
- StrPCopy(DriveStr[Drives],path);
- inc(Drives);
- if Drives>26 then
- Drives:=4;
- Result:=Drives;
- end;
- Function DiskFree(Drive: Byte): int64;
- var
- fs : tstatfs;
- Begin
- if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and (statfs(StrPas(fixdrivestr[drive]),fs)<>-1)) or
- ((not (drivestr[Drive]=nil)) and (statfs(StrPas(drivestr[drive]),fs)<>-1)) then
- Diskfree:=int64(fs.bavail)*int64(fs.bsize)
- else
- Diskfree:=-1;
- End;
- Function DiskSize(Drive: Byte): int64;
- var
- fs : tstatfs;
- Begin
- if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and (statfs(StrPas(fixdrivestr[drive]),fs)<>-1)) or
- ((not (drivestr[Drive]=nil)) and (statfs(StrPas(drivestr[drive]),fs)<>-1)) then
- DiskSize:=int64(fs.blocks)*int64(fs.bsize)
- else
- DiskSize:=-1;
- End;
- Function GetCurrentDir : String;
- begin
- GetDir (0,Result);
- end;
- Function SetCurrentDir (Const NewDir : String) : Boolean;
- begin
- {$I-}
- ChDir(NewDir);
- {$I+}
- result := (IOResult = 0);
- end;
- Function CreateDir (Const NewDir : String) : Boolean;
- begin
- {$I-}
- MkDir(NewDir);
- {$I+}
- result := (IOResult = 0);
- end;
- Function RemoveDir (Const Dir : String) : Boolean;
- begin
- {$I-}
- RmDir(Dir);
- {$I+}
- result := (IOResult = 0);
- end;
- {****************************************************************************
- Misc Functions
- ****************************************************************************}
- procedure Beep;
- begin
- end;
- {****************************************************************************
- Locale Functions
- ****************************************************************************}
- Function GetEpochTime: cint;
- {
- Get the number of seconds since 00:00, January 1 1970, GMT
- the time NOT corrected any way
- }
- begin
- GetEpochTime:=fptime;
- end;
- procedure GetTime(var hour,min,sec,msec,usec:word);
- {
- Gets the current time, adjusted to local time
- }
- var
- year,day,month:Word;
- tz:timeval;
- begin
- fpgettimeofday(@tz,nil);
- EpochToLocal(tz.tv_sec,year,month,day,hour,min,sec);
- msec:=tz.tv_usec div 1000;
- usec:=tz.tv_usec mod 1000;
- end;
- procedure GetTime(var hour,min,sec,sec100:word);
- {
- Gets the current time, adjusted to local time
- }
- var
- usec : word;
- begin
- gettime(hour,min,sec,sec100,usec);
- sec100:=sec100 div 10;
- end;
- Procedure GetTime(Var Hour,Min,Sec:Word);
- {
- Gets the current time, adjusted to local time
- }
- var
- msec,usec : Word;
- Begin
- gettime(hour,min,sec,msec,usec);
- End;
- Procedure GetDate(Var Year,Month,Day:Word);
- {
- Gets the current date, adjusted to local time
- }
- var
- hour,minute,second : word;
- Begin
- EpochToLocal(fptime,year,month,day,hour,minute,second);
- End;
- Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
- {
- Gets the current date, adjusted to local time
- }
- Begin
- EpochToLocal(fptime,year,month,day,hour,minute,second);
- End;
- Procedure GetLocalTime(var SystemTime: TSystemTime);
- var
- usecs : Word;
- begin
- GetTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond, usecs);
- GetDate(SystemTime.Year, SystemTime.Month, SystemTime.Day);
- // SystemTime.MilliSecond := 0;
- end ;
- Procedure InitAnsi;
- Var
- i : longint;
- begin
- { Fill table entries 0 to 127 }
- for i := 0 to 96 do
- UpperCaseTable[i] := chr(i);
- for i := 97 to 122 do
- UpperCaseTable[i] := chr(i - 32);
- for i := 123 to 191 do
- UpperCaseTable[i] := chr(i);
- Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
- for i := 0 to 64 do
- LowerCaseTable[i] := chr(i);
- for i := 65 to 90 do
- LowerCaseTable[i] := chr(i + 32);
- for i := 91 to 191 do
- LowerCaseTable[i] := chr(i);
- Move (CPISO88591LCT,LowerCaseTable[192],SizeOf(CPISO88591UCT));
- end;
- Procedure InitInternational;
- begin
- InitInternationalGeneric;
- InitAnsi;
- end;
- function SysErrorMessage(ErrorCode: Integer): String;
- begin
- Result:=StrError(ErrorCode);
- end;
- {****************************************************************************
- OS utility functions
- ****************************************************************************}
- Function GetEnvironmentVariable(Const EnvVar : String) : String;
- begin
- Result:=StrPas(BaseUnix.FPGetenv(PChar(EnvVar)));
- end;
- Function GetEnvironmentVariableCount : Integer;
- begin
- Result:=FPCCountEnvVar(EnvP);
- end;
- Function GetEnvironmentString(Index : Integer) : String;
- begin
- Result:=FPCGetEnvStrFromP(Envp,Index);
- end;
- {$define FPC_USE_FPEXEC} // leave the old code under IFDEF for a while.
- function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
- var
- pid : longint;
- e : EOSError;
- CommandLine: AnsiString;
- cmdline2 : ppchar;
- Begin
- { always surround the name of the application by quotes
- so that long filenames will always be accepted. But don't
- do it if there are already double quotes!
- }
- {$ifdef FPC_USE_FPEXEC} // Only place we still parse
- cmdline2:=nil;
- if Comline<>'' Then
- begin
- CommandLine:=ComLine;
- { Make an unique copy because stringtoppchar modifies the
- string }
- UniqueString(CommandLine);
- cmdline2:=StringtoPPChar(CommandLine,1);
- cmdline2^:=pchar(Path);
- end
- else
- begin
- getmem(cmdline2,2*sizeof(pchar));
- cmdline2^:=pchar(Path);
- cmdline2[1]:=nil;
- end;
- {$else}
- if Pos ('"', Path) = 0 then
- CommandLine := '"' + Path + '"'
- else
- CommandLine := Path;
- if ComLine <> '' then
- CommandLine := Commandline + ' ' + ComLine;
- {$endif}
- {$ifdef USE_VFORK}
- pid:=fpvFork;
- {$else USE_VFORK}
- pid:=fpFork;
- {$endif USE_VFORK}
- if pid=0 then
- begin
- {The child does the actual exec, and then exits}
- {$ifdef FPC_USE_FPEXEC}
- fpexecv(pchar(Path),Cmdline2);
- {$else}
- Execl(CommandLine);
- {$endif}
- { If the execve fails, we return an exitvalue of 127, to let it be known}
- fpExit(127);
- end
- else
- if pid=-1 then {Fork failed}
- begin
- e:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,-1]);
- e.ErrorCode:=-1;
- raise e;
- end;
- { We're in the parent, let's wait. }
- result:=WaitProcess(pid); // WaitPid and result-convert
- {$ifdef FPC_USE_FPEXEC}
- if Comline<>'' Then
- freemem(cmdline2);
- {$endif}
- if (result<0) or (result=127) then
- begin
- E:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,result]);
- E.ErrorCode:=result;
- Raise E;
- end;
- End;
- function ExecuteProcess(Const Path: AnsiString; Const ComLine: Array Of AnsiString):integer;
- var
- pid : longint;
- e : EOSError;
- Begin
- pid:=fpFork;
- if pid=0 then
- begin
- {The child does the actual exec, and then exits}
- fpexecl(Path,Comline);
- { If the execve fails, we return an exitvalue of 127, to let it be known}
- fpExit(127);
- end
- else
- if pid=-1 then {Fork failed}
- begin
- e:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,-1]);
- e.ErrorCode:=-1;
- raise e;
- end;
- { We're in the parent, let's wait. }
- result:=WaitProcess(pid); // WaitPid and result-convert
- if (result<0) or (result=127) then
- begin
- E:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,result]);
- E.ErrorCode:=result;
- raise E;
- end;
- End;
- procedure Sleep(milliseconds: Cardinal);
- Var
- timeout,timeoutresult : TTimespec;
- begin
- timeout.tv_sec:=milliseconds div 1000;
- timeout.tv_nsec:=1000*1000*(milliseconds mod 1000);
- fpnanosleep(@timeout,@timeoutresult);
- end;
- Function GetLastOSError : Integer;
- begin
- Result:=fpgetErrNo;
- end;
- { ---------------------------------------------------------------------
- Application config files
- ---------------------------------------------------------------------}
- Function GetHomeDir : String;
- begin
- Result:=GetEnvironmentVariable('HOME');
- If (Result<>'') then
- Result:=IncludeTrailingPathDelimiter(Result);
- end;
- { Follows base-dir spec,
- see [http://freedesktop.org/Standards/basedir-spec].
- Always ends with PathDelim. }
- Function XdgConfigHome : String;
- begin
- Result:=GetEnvironmentVariable('XDG_CONFIG_HOME');
- if (Result='') then
- Result:=GetHomeDir + '.config/'
- else
- Result:=IncludeTrailingPathDelimiter(Result);
- end;
- Function GetAppConfigDir(Global : Boolean) : String;
- begin
- If Global then
- Result:=SysConfigDir
- else
- Result:=XdgConfigHome + ApplicationName;
- end;
- Function GetAppConfigFile(Global : Boolean; SubDir : Boolean) : String;
- begin
- if Global then
- begin
- Result:=IncludeTrailingPathDelimiter(SysConfigDir);
- if SubDir then
- Result:=IncludeTrailingPathDelimiter(Result+ApplicationName);
- Result:=Result+ApplicationName+ConfigExtension;
- end
- else
- begin
- if SubDir then
- begin
- Result:=IncludeTrailingPathDelimiter(GetAppConfigDir(False));
- Result:=Result+ApplicationName+ConfigExtension;
- end
- else
- begin
- Result:=XdgConfigHome + ApplicationName + ConfigExtension;
- end;
- end;
- end;
- {****************************************************************************
- Initialization code
- ****************************************************************************}
- Function GetTempDir(Global : Boolean) : String;
- begin
- If Assigned(OnGetTempDir) then
- Result:=OnGetTempDir(Global)
- else
- begin
- Result:=GetEnvironmentVariable('TEMP');
- If (Result='') Then
- Result:=GetEnvironmentVariable('TMP');
- if (Result='') then
- Result:='/tmp/' // fallback.
- end;
- if (Result<>'') then
- Result:=IncludeTrailingPathDelimiter(Result);
- end;
- {****************************************************************************
- Initialization code
- ****************************************************************************}
- Initialization
- InitExceptions; { Initialize exceptions. OS independent }
- InitInternational; { Initialize internationalization settings }
- SysConfigDir:='/etc'; { Initialize system config dir }
- Finalization
- DoneExceptions;
- end.
|