sysutils.pp 26 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2000 by Florian Klaempfl
  4. member of the Free Pascal development team
  5. Sysutils unit for linux
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. unit sysutils;
  13. interface
  14. {$MODE objfpc}
  15. { force ansistrings }
  16. {$H+}
  17. {$if (defined(BSD) or defined(SUNOS)) and defined(FPC_USE_LIBC)}
  18. {$define USE_VFORK}
  19. {$endif}
  20. {$DEFINE OS_FILESETDATEBYNAME}
  21. {$DEFINE HAS_SLEEP}
  22. {$DEFINE HAS_OSERROR}
  23. {$DEFINE HAS_OSCONFIG}
  24. {$DEFINE HAS_TEMPDIR}
  25. {$DEFINE HASUNIX}
  26. {$DEFINE HASCREATEGUID}
  27. {$DEFINE HAS_OSUSERDIR}
  28. uses
  29. Unix,errors,sysconst,Unixtype;
  30. { Include platform independent interface part }
  31. {$i sysutilh.inc}
  32. Function AddDisk(const path:string) : Byte;
  33. { the following is Kylix compatibility stuff, it should be moved to a
  34. special compatibilty unit (FK) }
  35. const
  36. RTL_SIGINT = 0;
  37. RTL_SIGFPE = 1;
  38. RTL_SIGSEGV = 2;
  39. RTL_SIGILL = 3;
  40. RTL_SIGBUS = 4;
  41. RTL_SIGQUIT = 5;
  42. RTL_SIGLAST = RTL_SIGQUIT;
  43. RTL_SIGDEFAULT = -1;
  44. type
  45. TSignalState = (ssNotHooked, ssHooked, ssOverridden);
  46. function InquireSignal(RtlSigNum: Integer): TSignalState;
  47. procedure AbandonSignalHandler(RtlSigNum: Integer);
  48. procedure HookSignal(RtlSigNum: Integer);
  49. procedure UnhookSignal(RtlSigNum: Integer; OnlyIfHooked: Boolean = True);
  50. implementation
  51. Uses
  52. {$ifdef FPC_USE_LIBC}initc{$ELSE}Syscall{$ENDIF}, Baseunix, unixutil;
  53. function InquireSignal(RtlSigNum: Integer): TSignalState;
  54. begin
  55. end;
  56. procedure AbandonSignalHandler(RtlSigNum: Integer);
  57. begin
  58. end;
  59. procedure HookSignal(RtlSigNum: Integer);
  60. begin
  61. end;
  62. procedure UnhookSignal(RtlSigNum: Integer; OnlyIfHooked: Boolean = True);
  63. begin
  64. end;
  65. {$Define OS_FILEISREADONLY} // Specific implementation for Unix.
  66. {$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
  67. {$DEFINE FPC_FEXPAND_GETENVPCHAR} { GetEnv result is a PChar }
  68. { Include platform independent implementation part }
  69. {$i sysutils.inc}
  70. { Include SysCreateGUID function }
  71. {$i suuid.inc}
  72. Const
  73. {Date Translation}
  74. C1970=2440588;
  75. D0 = 1461;
  76. D1 = 146097;
  77. D2 =1721119;
  78. Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
  79. Var
  80. YYear,XYear,Temp,TempMonth : LongInt;
  81. Begin
  82. Temp:=((JulianDN-D2) shl 2)-1;
  83. JulianDN:=Temp Div D1;
  84. XYear:=(Temp Mod D1) or 3;
  85. YYear:=(XYear Div D0);
  86. Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
  87. Day:=((Temp Mod 153)+5) Div 5;
  88. TempMonth:=Temp Div 153;
  89. If TempMonth>=10 Then
  90. Begin
  91. inc(YYear);
  92. dec(TempMonth,12);
  93. End;
  94. inc(TempMonth,3);
  95. Month := TempMonth;
  96. Year:=YYear+(JulianDN*100);
  97. end;
  98. Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
  99. {
  100. Transforms Epoch time into local time (hour, minute,seconds)
  101. }
  102. Var
  103. DateNum: LongInt;
  104. Begin
  105. inc(Epoch,TZSeconds);
  106. Datenum:=(Epoch Div 86400) + c1970;
  107. JulianToGregorian(DateNum,Year,Month,day);
  108. Epoch:=Abs(Epoch Mod 86400);
  109. Hour:=Epoch Div 3600;
  110. Epoch:=Epoch Mod 3600;
  111. Minute:=Epoch Div 60;
  112. Second:=Epoch Mod 60;
  113. End;
  114. {****************************************************************************
  115. File Functions
  116. ****************************************************************************}
  117. Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
  118. Var
  119. DotPos,SlashPos,i : longint;
  120. Begin
  121. SlashPos:=0;
  122. DotPos:=256;
  123. i:=Length(Path);
  124. While (i>0) and (SlashPos=0) Do
  125. Begin
  126. If (DotPos=256) and (Path[i]='.') Then
  127. begin
  128. DotPos:=i;
  129. end;
  130. If (Path[i]='/') Then
  131. SlashPos:=i;
  132. Dec(i);
  133. End;
  134. Ext:=Copy(Path,DotPos,255);
  135. Dir:=Copy(Path,1,SlashPos);
  136. Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
  137. End;
  138. Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
  139. Var LinuxFlags : longint;
  140. BEGIN
  141. LinuxFlags:=0;
  142. Case (Mode and 3) of
  143. 0 : LinuxFlags:=LinuxFlags or O_RdOnly;
  144. 1 : LinuxFlags:=LinuxFlags or O_WrOnly;
  145. 2 : LinuxFlags:=LinuxFlags or O_RdWr;
  146. end;
  147. FileOpen:=fpOpen (pointer(FileName),LinuxFlags);
  148. //!! We need to set locking based on Mode !!
  149. end;
  150. Function FileCreate (Const FileName : String) : Longint;
  151. begin
  152. FileCreate:=fpOpen(pointer(FileName),O_RdWr or O_Creat or O_Trunc);
  153. end;
  154. Function FileCreate (Const FileName : String;Mode : Longint) : Longint;
  155. BEGIN
  156. FileCreate:=fpOpen(pointer(FileName),O_RdWr or O_Creat or O_Trunc,Mode);
  157. end;
  158. Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
  159. begin
  160. FileRead:=fpRead (Handle,Buffer,Count);
  161. end;
  162. Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
  163. begin
  164. FileWrite:=fpWrite (Handle,Buffer,Count);
  165. end;
  166. Function FileSeek (Handle,FOffset,Origin : Longint) : Longint;
  167. begin
  168. result:=longint(FileSeek(Handle,int64(FOffset),Origin));
  169. end;
  170. Function FileSeek (Handle : Longint; FOffset : Int64; Origin : Longint) : Int64;
  171. begin
  172. FileSeek:=fplSeek (Handle,FOffset,Origin);
  173. end;
  174. Procedure FileClose (Handle : Longint);
  175. begin
  176. fpclose(Handle);
  177. end;
  178. Function FileTruncate (Handle: THandle; Size: Int64) : boolean;
  179. begin
  180. if (SizeOf (TOff) < 8) (* fpFTruncate only supporting signed 32-bit size *)
  181. and (Size > high (longint)) then
  182. FileTruncate := false
  183. else
  184. FileTruncate:=fpftruncate(Handle,Size)>=0;
  185. end;
  186. {$ifndef FPUNONE}
  187. Function UnixToWinAge(UnixAge : time_t): Longint;
  188. Var
  189. Y,M,D,hh,mm,ss : word;
  190. begin
  191. EpochToLocal(UnixAge,y,m,d,hh,mm,ss);
  192. Result:=DateTimeToFileDate(EncodeDate(y,m,d)+EncodeTime(hh,mm,ss,0));
  193. end;
  194. Function FileAge (Const FileName : String): Longint;
  195. Var Info : Stat;
  196. begin
  197. If fpstat (pointer(FileName),Info)<0 then
  198. exit(-1)
  199. else
  200. Result:=UnixToWinAge(info.st_mtime);
  201. end;
  202. {$endif}
  203. Function FileExists (Const FileName : String) : Boolean;
  204. begin
  205. // Don't use stat. It fails on files >2 GB.
  206. // Access obeys the same access rules, so the result should be the same.
  207. FileExists:=fpAccess(pointer(filename),F_OK)=0;
  208. end;
  209. Function DirectoryExists (Const Directory : String) : Boolean;
  210. Var Info : Stat;
  211. begin
  212. DirectoryExists:=(fpstat(pointer(Directory),Info)>=0) and fpS_ISDIR(Info.st_mode);
  213. end;
  214. Function LinuxToWinAttr (FN : Pchar; Const Info : Stat) : Longint;
  215. begin
  216. Result:=faArchive;
  217. If fpS_ISDIR(Info.st_mode) then
  218. Result:=Result or faDirectory;
  219. If (FN[0]='.') and (not (FN[1] in [#0,'.'])) then
  220. Result:=Result or faHidden;
  221. If (Info.st_Mode and S_IWUSR)=0 Then
  222. Result:=Result or faReadOnly;
  223. 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
  224. Result:=Result or faSysFile;
  225. If fpS_ISLNK(Info.st_mode) Then
  226. Result:=Result or faSymLink;
  227. end;
  228. Function FNMatch(const Pattern,Name:string):Boolean;
  229. Var
  230. LenPat,LenName : longint;
  231. Function DoFNMatch(i,j:longint):Boolean;
  232. Var
  233. Found : boolean;
  234. Begin
  235. Found:=true;
  236. While Found and (i<=LenPat) Do
  237. Begin
  238. Case Pattern[i] of
  239. '?' : Found:=(j<=LenName);
  240. '*' : Begin
  241. {find the next character in pattern, different of ? and *}
  242. while Found do
  243. begin
  244. inc(i);
  245. if i>LenPat then Break;
  246. case Pattern[i] of
  247. '*' : ;
  248. '?' : begin
  249. if j>LenName then begin DoFNMatch:=false; Exit; end;
  250. inc(j);
  251. end;
  252. else
  253. Found:=false;
  254. end;
  255. end;
  256. Assert((i>LenPat) or ( (Pattern[i]<>'*') and (Pattern[i]<>'?') ));
  257. {Now, find in name the character which i points to, if the * or ?
  258. wasn't the last character in the pattern, else, use up all the
  259. chars in name}
  260. Found:=false;
  261. if (i<=LenPat) then
  262. begin
  263. repeat
  264. {find a letter (not only first !) which maches pattern[i]}
  265. while (j<=LenName) and (name[j]<>pattern[i]) do
  266. inc (j);
  267. if (j<LenName) then
  268. begin
  269. if DoFnMatch(i+1,j+1) then
  270. begin
  271. i:=LenPat;
  272. j:=LenName;{we can stop}
  273. Found:=true;
  274. Break;
  275. end else
  276. inc(j);{We didn't find one, need to look further}
  277. end else
  278. if j=LenName then
  279. begin
  280. Found:=true;
  281. Break;
  282. end;
  283. { This 'until' condition must be j>LenName, not j>=LenName.
  284. That's because when we 'need to look further' and
  285. j = LenName then loop must not terminate. }
  286. until (j>LenName);
  287. end else
  288. begin
  289. j:=LenName;{we can stop}
  290. Found:=true;
  291. end;
  292. end;
  293. else {not a wildcard character in pattern}
  294. Found:=(j<=LenName) and (pattern[i]=name[j]);
  295. end;
  296. inc(i);
  297. inc(j);
  298. end;
  299. DoFnMatch:=Found and (j>LenName);
  300. end;
  301. Begin {start FNMatch}
  302. LenPat:=Length(Pattern);
  303. LenName:=Length(Name);
  304. FNMatch:=DoFNMatch(1,1);
  305. End;
  306. Type
  307. TUnixFindData = Record
  308. NamePos : LongInt; {to track which search this is}
  309. DirPtr : Pointer; {directory pointer for reading directory}
  310. SearchSpec : String;
  311. SearchType : Byte; {0=normal, 1=open will close, 2=only 1 file}
  312. SearchAttr : Byte; {attribute we are searching for}
  313. End;
  314. PUnixFindData = ^TUnixFindData;
  315. Var
  316. CurrSearchNum : LongInt;
  317. Procedure FindClose(Var f: TSearchRec);
  318. var
  319. UnixFindData : PUnixFindData;
  320. Begin
  321. UnixFindData:=PUnixFindData(f.FindHandle);
  322. if UnixFindData=nil then
  323. exit;
  324. if UnixFindData^.SearchType=0 then
  325. begin
  326. if UnixFindData^.dirptr<>nil then
  327. fpclosedir(pdir(UnixFindData^.dirptr)^);
  328. end;
  329. Dispose(UnixFindData);
  330. f.FindHandle:=nil;
  331. End;
  332. Function FindGetFileInfo(const s:string;var f:TSearchRec):boolean;
  333. var
  334. st : baseunix.stat;
  335. WinAttr : longint;
  336. begin
  337. FindGetFileInfo:=false;
  338. if not fpstat(pointer(s),st)>=0 then
  339. exit;
  340. WinAttr:=LinuxToWinAttr(PChar(pointer(s)),st);
  341. If (f.FindHandle = nil) or ((WinAttr and Not(PUnixFindData(f.FindHandle)^.searchattr))=0) Then
  342. Begin
  343. f.Name:=ExtractFileName(s);
  344. f.Attr:=WinAttr;
  345. f.Size:=st.st_Size;
  346. f.Mode:=st.st_mode;
  347. {$ifndef FPUNONE}
  348. f.Time:=UnixToWinAge(st.st_mtime);
  349. {$endif}
  350. result:=true;
  351. End;
  352. end;
  353. Function FindNext (Var Rslt : TSearchRec) : Longint;
  354. {
  355. re-opens dir if not already in array and calls FindWorkProc
  356. }
  357. Var
  358. DirName : String;
  359. i,
  360. ArrayPos : Longint;
  361. FName,
  362. SName : string;
  363. Found,
  364. Finished : boolean;
  365. p : pdirent;
  366. UnixFindData : PUnixFindData;
  367. Begin
  368. Result:=-1;
  369. UnixFindData:=PUnixFindData(Rslt.FindHandle);
  370. if UnixFindData=nil then
  371. exit;
  372. if (UnixFindData^.SearchType=0) and
  373. (UnixFindData^.Dirptr=nil) then
  374. begin
  375. If UnixFindData^.NamePos = 0 Then
  376. DirName:='./'
  377. Else
  378. DirName:=Copy(UnixFindData^.SearchSpec,1,UnixFindData^.NamePos);
  379. UnixFindData^.DirPtr := fpopendir(Pchar(pointer(DirName)));
  380. end;
  381. SName:=Copy(UnixFindData^.SearchSpec,UnixFindData^.NamePos+1,Length(UnixFindData^.SearchSpec));
  382. Found:=False;
  383. Finished:=(UnixFindData^.dirptr=nil);
  384. While Not Finished Do
  385. Begin
  386. p:=fpreaddir(pdir(UnixFindData^.dirptr)^);
  387. if p=nil then
  388. FName:=''
  389. else
  390. FName:=p^.d_name;
  391. If FName='' Then
  392. Finished:=True
  393. Else
  394. Begin
  395. If FNMatch(SName,FName) Then
  396. Begin
  397. Found:=FindGetFileInfo(Copy(UnixFindData^.SearchSpec,1,UnixFindData^.NamePos)+FName,Rslt);
  398. if Found then
  399. begin
  400. Result:=0;
  401. exit;
  402. end;
  403. End;
  404. End;
  405. End;
  406. End;
  407. Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
  408. {
  409. opens dir and calls FindWorkProc
  410. }
  411. var
  412. UnixFindData : PUnixFindData;
  413. Begin
  414. Result:=-1;
  415. fillchar(Rslt,sizeof(Rslt),0);
  416. if Path='' then
  417. exit;
  418. {Wildcards?}
  419. if (Pos('?',Path)=0) and (Pos('*',Path)=0) then
  420. begin
  421. if FindGetFileInfo(Path,Rslt) then
  422. Result:=0;
  423. end
  424. else
  425. begin
  426. { Allocate UnixFindData }
  427. New(UnixFindData);
  428. FillChar(UnixFindData^,sizeof(UnixFindData^),0);
  429. Rslt.FindHandle:=UnixFindData;
  430. {Create Info}
  431. UnixFindData^.SearchSpec := Path;
  432. {We always also search for readonly and archive, regardless of Attr:}
  433. UnixFindData^.SearchAttr := Attr or faarchive or fareadonly;
  434. UnixFindData^.NamePos := Length(UnixFindData^.SearchSpec);
  435. while (UnixFindData^.NamePos>0) and (UnixFindData^.SearchSpec[UnixFindData^.NamePos]<>'/') do
  436. dec(UnixFindData^.NamePos);
  437. Result:=FindNext(Rslt);
  438. end;
  439. End;
  440. Function FileGetDate (Handle : Longint) : Longint;
  441. Var Info : Stat;
  442. begin
  443. If (fpFStat(Handle,Info))<0 then
  444. Result:=-1
  445. else
  446. Result:=Info.st_Mtime;
  447. end;
  448. Function FileSetDate (Handle,Age : Longint) : Longint;
  449. begin
  450. // Impossible under Linux from FileHandle !!
  451. FileSetDate:=-1;
  452. end;
  453. Function FileGetAttr (Const FileName : String) : Longint;
  454. Var Info : Stat;
  455. begin
  456. If FpStat (pointer(FileName),Info)<0 then
  457. Result:=-1
  458. Else
  459. Result:=LinuxToWinAttr(Pchar(ExtractFileName(FileName)),Info);
  460. end;
  461. Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
  462. begin
  463. Result:=-1;
  464. end;
  465. Function DeleteFile (Const FileName : String) : Boolean;
  466. begin
  467. Result:=fpUnLink (pointer(FileName))>=0;
  468. end;
  469. Function RenameFile (Const OldName, NewName : String) : Boolean;
  470. begin
  471. RenameFile:=BaseUnix.FpRename(pointer(OldNAme),pointer(NewName))>=0;
  472. end;
  473. Function FileIsReadOnly(const FileName: String): Boolean;
  474. begin
  475. Result := fpAccess(PChar(pointer(FileName)),W_OK)<>0;
  476. end;
  477. Function FileSetDate (Const FileName : String;Age : Longint) : Longint;
  478. var
  479. t: TUTimBuf;
  480. begin
  481. Result := 0;
  482. t.actime := Age;
  483. t.modtime := Age;
  484. if fputime(PChar(pointer(FileName)), @t) = -1 then
  485. Result := fpgeterrno;
  486. end;
  487. {****************************************************************************
  488. Disk Functions
  489. ****************************************************************************}
  490. {
  491. The Diskfree and Disksize functions need a file on the specified drive, since this
  492. is required for the statfs system call.
  493. These filenames are set in drivestr[0..26], and have been preset to :
  494. 0 - '.' (default drive - hence current dir is ok.)
  495. 1 - '/fd0/.' (floppy drive 1 - should be adapted to local system )
  496. 2 - '/fd1/.' (floppy drive 2 - should be adapted to local system )
  497. 3 - '/' (C: equivalent of dos is the root partition)
  498. 4..26 (can be set by you're own applications)
  499. ! Use AddDisk() to Add new drives !
  500. They both return -1 when a failure occurs.
  501. }
  502. Const
  503. FixDriveStr : array[0..3] of pchar=(
  504. '.',
  505. '/fd0/.',
  506. '/fd1/.',
  507. '/.'
  508. );
  509. var
  510. Drives : byte;
  511. DriveStr : array[4..26] of pchar;
  512. Function AddDisk(const path:string) : Byte;
  513. begin
  514. if not (DriveStr[Drives]=nil) then
  515. FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
  516. GetMem(DriveStr[Drives],length(Path)+1);
  517. StrPCopy(DriveStr[Drives],path);
  518. inc(Drives);
  519. if Drives>26 then
  520. Drives:=4;
  521. Result:=Drives;
  522. end;
  523. Function DiskFree(Drive: Byte): int64;
  524. var
  525. fs : tstatfs;
  526. Begin
  527. if ((Drive in [Low(FixDriveStr)..High(FixDriveStr)]) and (not (fixdrivestr[Drive]=nil)) and (statfs(StrPas(fixdrivestr[drive]),fs)<>-1)) or
  528. ((Drive <= High(drivestr)) and (not (drivestr[Drive]=nil)) and (statfs(StrPas(drivestr[drive]),fs)<>-1)) then
  529. Diskfree:=int64(fs.bavail)*int64(fs.bsize)
  530. else
  531. Diskfree:=-1;
  532. End;
  533. Function DiskSize(Drive: Byte): int64;
  534. var
  535. fs : tstatfs;
  536. Begin
  537. if ((Drive in [Low(FixDriveStr)..High(FixDriveStr)]) and (not (fixdrivestr[Drive]=nil)) and (statfs(StrPas(fixdrivestr[drive]),fs)<>-1)) or
  538. ((drive <= High(drivestr)) and (not (drivestr[Drive]=nil)) and (statfs(StrPas(drivestr[drive]),fs)<>-1)) then
  539. DiskSize:=int64(fs.blocks)*int64(fs.bsize)
  540. else
  541. DiskSize:=-1;
  542. End;
  543. Function GetCurrentDir : String;
  544. begin
  545. GetDir (0,Result);
  546. end;
  547. Function SetCurrentDir (Const NewDir : String) : Boolean;
  548. begin
  549. {$I-}
  550. ChDir(NewDir);
  551. {$I+}
  552. result := (IOResult = 0);
  553. end;
  554. Function CreateDir (Const NewDir : String) : Boolean;
  555. begin
  556. {$I-}
  557. MkDir(NewDir);
  558. {$I+}
  559. result := (IOResult = 0);
  560. end;
  561. Function RemoveDir (Const Dir : String) : Boolean;
  562. begin
  563. {$I-}
  564. RmDir(Dir);
  565. {$I+}
  566. result := (IOResult = 0);
  567. end;
  568. {****************************************************************************
  569. Misc Functions
  570. ****************************************************************************}
  571. procedure Beep;
  572. begin
  573. end;
  574. {****************************************************************************
  575. Locale Functions
  576. ****************************************************************************}
  577. Function GetEpochTime: cint;
  578. {
  579. Get the number of seconds since 00:00, January 1 1970, GMT
  580. the time NOT corrected any way
  581. }
  582. begin
  583. GetEpochTime:=fptime;
  584. end;
  585. procedure GetTime(var hour,min,sec,msec,usec:word);
  586. {
  587. Gets the current time, adjusted to local time
  588. }
  589. var
  590. year,day,month:Word;
  591. tz:timeval;
  592. begin
  593. fpgettimeofday(@tz,nil);
  594. EpochToLocal(tz.tv_sec,year,month,day,hour,min,sec);
  595. msec:=tz.tv_usec div 1000;
  596. usec:=tz.tv_usec mod 1000;
  597. end;
  598. procedure GetTime(var hour,min,sec,sec100:word);
  599. {
  600. Gets the current time, adjusted to local time
  601. }
  602. var
  603. usec : word;
  604. begin
  605. gettime(hour,min,sec,sec100,usec);
  606. sec100:=sec100 div 10;
  607. end;
  608. Procedure GetTime(Var Hour,Min,Sec:Word);
  609. {
  610. Gets the current time, adjusted to local time
  611. }
  612. var
  613. msec,usec : Word;
  614. Begin
  615. gettime(hour,min,sec,msec,usec);
  616. End;
  617. Procedure GetDate(Var Year,Month,Day:Word);
  618. {
  619. Gets the current date, adjusted to local time
  620. }
  621. var
  622. hour,minute,second : word;
  623. Begin
  624. EpochToLocal(fptime,year,month,day,hour,minute,second);
  625. End;
  626. Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
  627. {
  628. Gets the current date, adjusted to local time
  629. }
  630. Begin
  631. EpochToLocal(fptime,year,month,day,hour,minute,second);
  632. End;
  633. {$ifndef FPUNONE}
  634. Procedure GetLocalTime(var SystemTime: TSystemTime);
  635. var
  636. usecs : Word;
  637. begin
  638. GetTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond, usecs);
  639. GetDate(SystemTime.Year, SystemTime.Month, SystemTime.Day);
  640. // SystemTime.MilliSecond := 0;
  641. end ;
  642. {$endif}
  643. Procedure InitAnsi;
  644. Var
  645. i : longint;
  646. begin
  647. { Fill table entries 0 to 127 }
  648. for i := 0 to 96 do
  649. UpperCaseTable[i] := chr(i);
  650. for i := 97 to 122 do
  651. UpperCaseTable[i] := chr(i - 32);
  652. for i := 123 to 191 do
  653. UpperCaseTable[i] := chr(i);
  654. Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
  655. for i := 0 to 64 do
  656. LowerCaseTable[i] := chr(i);
  657. for i := 65 to 90 do
  658. LowerCaseTable[i] := chr(i + 32);
  659. for i := 91 to 191 do
  660. LowerCaseTable[i] := chr(i);
  661. Move (CPISO88591LCT,LowerCaseTable[192],SizeOf(CPISO88591UCT));
  662. end;
  663. Procedure InitInternational;
  664. begin
  665. InitInternationalGeneric;
  666. InitAnsi;
  667. end;
  668. function SysErrorMessage(ErrorCode: Integer): String;
  669. begin
  670. Result:=StrError(ErrorCode);
  671. end;
  672. {****************************************************************************
  673. OS utility functions
  674. ****************************************************************************}
  675. Function GetEnvironmentVariable(Const EnvVar : String) : String;
  676. begin
  677. Result:=StrPas(BaseUnix.FPGetenv(PChar(pointer(EnvVar))));
  678. end;
  679. Function GetEnvironmentVariableCount : Integer;
  680. begin
  681. Result:=FPCCountEnvVar(EnvP);
  682. end;
  683. Function GetEnvironmentString(Index : Integer) : String;
  684. begin
  685. Result:=FPCGetEnvStrFromP(Envp,Index);
  686. end;
  687. {$define FPC_USE_FPEXEC} // leave the old code under IFDEF for a while.
  688. function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
  689. var
  690. pid : longint;
  691. e : EOSError;
  692. CommandLine: AnsiString;
  693. cmdline2 : ppchar;
  694. Begin
  695. { always surround the name of the application by quotes
  696. so that long filenames will always be accepted. But don't
  697. do it if there are already double quotes!
  698. }
  699. {$ifdef FPC_USE_FPEXEC} // Only place we still parse
  700. cmdline2:=nil;
  701. if Comline<>'' Then
  702. begin
  703. CommandLine:=ComLine;
  704. { Make an unique copy because stringtoppchar modifies the
  705. string }
  706. UniqueString(CommandLine);
  707. cmdline2:=StringtoPPChar(CommandLine,1);
  708. cmdline2^:=pchar(pointer(Path));
  709. end
  710. else
  711. begin
  712. getmem(cmdline2,2*sizeof(pchar));
  713. cmdline2^:=pchar(Path);
  714. cmdline2[1]:=nil;
  715. end;
  716. {$else}
  717. if Pos ('"', Path) = 0 then
  718. CommandLine := '"' + Path + '"'
  719. else
  720. CommandLine := Path;
  721. if ComLine <> '' then
  722. CommandLine := Commandline + ' ' + ComLine;
  723. {$endif}
  724. {$ifdef USE_VFORK}
  725. pid:=fpvFork;
  726. {$else USE_VFORK}
  727. pid:=fpFork;
  728. {$endif USE_VFORK}
  729. if pid=0 then
  730. begin
  731. {The child does the actual exec, and then exits}
  732. {$ifdef FPC_USE_FPEXEC}
  733. fpexecv(pchar(pointer(Path)),Cmdline2);
  734. {$else}
  735. Execl(CommandLine);
  736. {$endif}
  737. { If the execve fails, we return an exitvalue of 127, to let it be known}
  738. fpExit(127);
  739. end
  740. else
  741. if pid=-1 then {Fork failed}
  742. begin
  743. e:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,-1]);
  744. e.ErrorCode:=-1;
  745. raise e;
  746. end;
  747. { We're in the parent, let's wait. }
  748. result:=WaitProcess(pid); // WaitPid and result-convert
  749. {$ifdef FPC_USE_FPEXEC}
  750. if Comline<>'' Then
  751. freemem(cmdline2);
  752. {$endif}
  753. if (result<0) or (result=127) then
  754. begin
  755. E:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,result]);
  756. E.ErrorCode:=result;
  757. Raise E;
  758. end;
  759. End;
  760. function ExecuteProcess(Const Path: AnsiString; Const ComLine: Array Of AnsiString):integer;
  761. var
  762. pid : longint;
  763. e : EOSError;
  764. Begin
  765. pid:=fpFork;
  766. if pid=0 then
  767. begin
  768. {The child does the actual exec, and then exits}
  769. fpexecl(Path,Comline);
  770. { If the execve fails, we return an exitvalue of 127, to let it be known}
  771. fpExit(127);
  772. end
  773. else
  774. if pid=-1 then {Fork failed}
  775. begin
  776. e:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,-1]);
  777. e.ErrorCode:=-1;
  778. raise e;
  779. end;
  780. { We're in the parent, let's wait. }
  781. result:=WaitProcess(pid); // WaitPid and result-convert
  782. if (result<0) or (result=127) then
  783. begin
  784. E:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,result]);
  785. E.ErrorCode:=result;
  786. raise E;
  787. end;
  788. End;
  789. procedure Sleep(milliseconds: Cardinal);
  790. Var
  791. timeout,timeoutresult : TTimespec;
  792. begin
  793. timeout.tv_sec:=milliseconds div 1000;
  794. timeout.tv_nsec:=1000*1000*(milliseconds mod 1000);
  795. fpnanosleep(@timeout,@timeoutresult);
  796. end;
  797. Function GetLastOSError : Integer;
  798. begin
  799. Result:=fpgetErrNo;
  800. end;
  801. { ---------------------------------------------------------------------
  802. Application config files
  803. ---------------------------------------------------------------------}
  804. Function GetHomeDir : String;
  805. begin
  806. Result:=GetEnvironmentVariable('HOME');
  807. If (Result<>'') then
  808. Result:=IncludeTrailingPathDelimiter(Result);
  809. end;
  810. { Follows base-dir spec,
  811. see [http://freedesktop.org/Standards/basedir-spec].
  812. Always ends with PathDelim. }
  813. Function XdgConfigHome : String;
  814. begin
  815. Result:=GetEnvironmentVariable('XDG_CONFIG_HOME');
  816. if (Result='') then
  817. Result:=GetHomeDir + '.config/'
  818. else
  819. Result:=IncludeTrailingPathDelimiter(Result);
  820. end;
  821. Function GetAppConfigDir(Global : Boolean) : String;
  822. begin
  823. If Global then
  824. Result:=SysConfigDir
  825. else
  826. Result:=XdgConfigHome;
  827. if VendorName<>'' then
  828. Result:=IncludeTrailingPathDelimiter(Result+VendorName);
  829. Result:=IncludeTrailingPathDelimiter(Result+ApplicationName);
  830. end;
  831. Function GetAppConfigFile(Global : Boolean; SubDir : Boolean) : String;
  832. begin
  833. If Global then
  834. Result:=SysConfigDir
  835. else
  836. Result:=XdgConfigHome;
  837. if SubDir then
  838. begin
  839. if VendorName<>'' then
  840. Result:=IncludeTrailingPathDelimiter(Result+VendorName);
  841. Result:=IncludeTrailingPathDelimiter(Result+ApplicationName);
  842. end;
  843. Result:=Result+ApplicationName+ConfigExtension;
  844. end;
  845. {****************************************************************************
  846. GetTempDir
  847. ****************************************************************************}
  848. Function GetTempDir(Global : Boolean) : String;
  849. begin
  850. If Assigned(OnGetTempDir) then
  851. Result:=OnGetTempDir(Global)
  852. else
  853. begin
  854. Result:=GetEnvironmentVariable('TEMP');
  855. If (Result='') Then
  856. Result:=GetEnvironmentVariable('TMP');
  857. if (Result='') then
  858. Result:='/tmp/' // fallback.
  859. end;
  860. if (Result<>'') then
  861. Result:=IncludeTrailingPathDelimiter(Result);
  862. end;
  863. {****************************************************************************
  864. GetUserDir
  865. ****************************************************************************}
  866. Var
  867. TheUserDir : String;
  868. Function GetUserDir : String;
  869. begin
  870. If (TheUserDir='') then
  871. begin
  872. TheUserDir:=GetEnvironmentVariable('HOME');
  873. if (TheUserDir<>'') then
  874. TheUserDir:=IncludeTrailingPathDelimiter(TheUserDir)
  875. else
  876. TheUserDir:=GetTempDir(False);
  877. end;
  878. Result:=TheUserDir;
  879. end;
  880. {****************************************************************************
  881. Initialization code
  882. ****************************************************************************}
  883. Initialization
  884. InitExceptions; { Initialize exceptions. OS independent }
  885. InitInternational; { Initialize internationalization settings }
  886. SysConfigDir:='/etc'; { Initialize system config dir }
  887. Finalization
  888. DoneExceptions;
  889. end.