sysutils.pp 26 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103
  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. Function UnixToWinAge(UnixAge : time_t): Longint;
  187. Var
  188. Y,M,D,hh,mm,ss : word;
  189. begin
  190. EpochToLocal(UnixAge,y,m,d,hh,mm,ss);
  191. Result:=DateTimeToFileDate(EncodeDate(y,m,d)+EncodeTime(hh,mm,ss,0));
  192. end;
  193. Function FileAge (Const FileName : String): Longint;
  194. Var Info : Stat;
  195. begin
  196. If fpstat (pointer(FileName),Info)<0 then
  197. exit(-1)
  198. else
  199. Result:=UnixToWinAge(info.st_mtime);
  200. end;
  201. Function FileExists (Const FileName : String) : Boolean;
  202. begin
  203. // Don't use stat. It fails on files >2 GB.
  204. // Access obeys the same access rules, so the result should be the same.
  205. FileExists:=fpAccess(pointer(filename),F_OK)=0;
  206. end;
  207. Function DirectoryExists (Const Directory : String) : Boolean;
  208. Var Info : Stat;
  209. begin
  210. DirectoryExists:=(fpstat(pointer(Directory),Info)>=0) and fpS_ISDIR(Info.st_mode);
  211. end;
  212. Function LinuxToWinAttr (FN : Pchar; Const Info : Stat) : Longint;
  213. Var
  214. FNL : String;
  215. LinkInfo : Stat;
  216. begin
  217. Result:=faArchive;
  218. If fpS_ISDIR(Info.st_mode) then
  219. Result:=Result or faDirectory;
  220. If (FN[0]='.') and (not (FN[1] in [#0,'.'])) then
  221. Result:=Result or faHidden;
  222. If (Info.st_Mode and S_IWUSR)=0 Then
  223. Result:=Result or faReadOnly;
  224. 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
  225. Result:=Result or faSysFile;
  226. If fpS_ISLNK(Info.st_mode) Then
  227. begin
  228. Result:=Result or faSymLink;
  229. // Windows reports if the link points to a directory.
  230. FNL:=StrPas(FN);
  231. if (fpstat(FNL,LinkInfo)>=0) and fpS_ISDIR(LinkInfo.st_mode) then
  232. Result := Result or faDirectory;
  233. end;
  234. end;
  235. Function FNMatch(const Pattern,Name:string):Boolean;
  236. Var
  237. LenPat,LenName : longint;
  238. Function DoFNMatch(i,j:longint):Boolean;
  239. Var
  240. Found : boolean;
  241. Begin
  242. Found:=true;
  243. While Found and (i<=LenPat) Do
  244. Begin
  245. Case Pattern[i] of
  246. '?' : Found:=(j<=LenName);
  247. '*' : Begin
  248. {find the next character in pattern, different of ? and *}
  249. while Found do
  250. begin
  251. inc(i);
  252. if i>LenPat then Break;
  253. case Pattern[i] of
  254. '*' : ;
  255. '?' : begin
  256. if j>LenName then begin DoFNMatch:=false; Exit; end;
  257. inc(j);
  258. end;
  259. else
  260. Found:=false;
  261. end;
  262. end;
  263. Assert((i>LenPat) or ( (Pattern[i]<>'*') and (Pattern[i]<>'?') ));
  264. {Now, find in name the character which i points to, if the * or ?
  265. wasn't the last character in the pattern, else, use up all the
  266. chars in name}
  267. Found:=false;
  268. if (i<=LenPat) then
  269. begin
  270. repeat
  271. {find a letter (not only first !) which maches pattern[i]}
  272. while (j<=LenName) and (name[j]<>pattern[i]) do
  273. inc (j);
  274. if (j<LenName) then
  275. begin
  276. if DoFnMatch(i+1,j+1) then
  277. begin
  278. i:=LenPat;
  279. j:=LenName;{we can stop}
  280. Found:=true;
  281. Break;
  282. end else
  283. inc(j);{We didn't find one, need to look further}
  284. end else
  285. if j=LenName then
  286. begin
  287. Found:=true;
  288. Break;
  289. end;
  290. { This 'until' condition must be j>LenName, not j>=LenName.
  291. That's because when we 'need to look further' and
  292. j = LenName then loop must not terminate. }
  293. until (j>LenName);
  294. end else
  295. begin
  296. j:=LenName;{we can stop}
  297. Found:=true;
  298. end;
  299. end;
  300. else {not a wildcard character in pattern}
  301. Found:=(j<=LenName) and (pattern[i]=name[j]);
  302. end;
  303. inc(i);
  304. inc(j);
  305. end;
  306. DoFnMatch:=Found and (j>LenName);
  307. end;
  308. Begin {start FNMatch}
  309. LenPat:=Length(Pattern);
  310. LenName:=Length(Name);
  311. FNMatch:=DoFNMatch(1,1);
  312. End;
  313. Type
  314. TUnixFindData = Record
  315. NamePos : LongInt; {to track which search this is}
  316. DirPtr : Pointer; {directory pointer for reading directory}
  317. SearchSpec : String;
  318. SearchType : Byte; {0=normal, 1=open will close, 2=only 1 file}
  319. SearchAttr : Byte; {attribute we are searching for}
  320. End;
  321. PUnixFindData = ^TUnixFindData;
  322. Var
  323. CurrSearchNum : LongInt;
  324. Procedure FindClose(Var f: TSearchRec);
  325. var
  326. UnixFindData : PUnixFindData;
  327. Begin
  328. UnixFindData:=PUnixFindData(f.FindHandle);
  329. if UnixFindData=nil then
  330. exit;
  331. if UnixFindData^.SearchType=0 then
  332. begin
  333. if UnixFindData^.dirptr<>nil then
  334. fpclosedir(pdir(UnixFindData^.dirptr)^);
  335. end;
  336. Dispose(UnixFindData);
  337. f.FindHandle:=nil;
  338. End;
  339. Function FindGetFileInfo(const s:string;var f:TSearchRec):boolean;
  340. var
  341. st : baseunix.stat;
  342. WinAttr : longint;
  343. begin
  344. FindGetFileInfo:=false;
  345. If Assigned(F.FindHandle) and ((((PUnixFindData(f.FindHandle)^.searchattr)) and faSymlink) > 0) then
  346. FindGetFileInfo:=(fplstat(pointer(s),st)=0)
  347. else
  348. FindGetFileInfo:=(fpstat(pointer(s),st)=0);
  349. If not FindGetFileInfo then
  350. exit;
  351. WinAttr:=LinuxToWinAttr(PChar(pointer(s)),st);
  352. If (f.FindHandle = nil) or ((WinAttr and Not(PUnixFindData(f.FindHandle)^.searchattr))=0) Then
  353. Begin
  354. f.Name:=ExtractFileName(s);
  355. f.Attr:=WinAttr;
  356. f.Size:=st.st_Size;
  357. f.Mode:=st.st_mode;
  358. f.Time:=UnixToWinAge(st.st_mtime);
  359. result:=true;
  360. End;
  361. end;
  362. Function FindNext (Var Rslt : TSearchRec) : Longint;
  363. {
  364. re-opens dir if not already in array and calls FindGetFileInfo
  365. }
  366. Var
  367. DirName : String;
  368. FName,
  369. SName : string;
  370. Found,
  371. Finished : boolean;
  372. p : pdirent;
  373. UnixFindData : PUnixFindData;
  374. Begin
  375. Result:=-1;
  376. UnixFindData:=PUnixFindData(Rslt.FindHandle);
  377. if UnixFindData=nil then
  378. exit;
  379. if (UnixFindData^.SearchType=0) and
  380. (UnixFindData^.Dirptr=nil) then
  381. begin
  382. If UnixFindData^.NamePos = 0 Then
  383. DirName:='./'
  384. Else
  385. DirName:=Copy(UnixFindData^.SearchSpec,1,UnixFindData^.NamePos);
  386. UnixFindData^.DirPtr := fpopendir(Pchar(pointer(DirName)));
  387. end;
  388. SName:=Copy(UnixFindData^.SearchSpec,UnixFindData^.NamePos+1,Length(UnixFindData^.SearchSpec));
  389. Found:=False;
  390. Finished:=(UnixFindData^.dirptr=nil);
  391. While Not Finished Do
  392. Begin
  393. p:=fpreaddir(pdir(UnixFindData^.dirptr)^);
  394. if p=nil then
  395. FName:=''
  396. else
  397. FName:=p^.d_name;
  398. If FName='' Then
  399. Finished:=True
  400. Else
  401. Begin
  402. If FNMatch(SName,FName) Then
  403. Begin
  404. Found:=FindGetFileInfo(Copy(UnixFindData^.SearchSpec,1,UnixFindData^.NamePos)+FName,Rslt);
  405. if Found then
  406. begin
  407. Result:=0;
  408. exit;
  409. end;
  410. End;
  411. End;
  412. End;
  413. End;
  414. Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
  415. {
  416. opens dir and calls FindNext if needed.
  417. }
  418. var
  419. UnixFindData : PUnixFindData;
  420. Begin
  421. Result:=-1;
  422. fillchar(Rslt,sizeof(Rslt),0);
  423. if Path='' then
  424. exit;
  425. {Wildcards?}
  426. if (Pos('?',Path)=0) and (Pos('*',Path)=0) then
  427. begin
  428. if FindGetFileInfo(Path,Rslt) then
  429. Result:=0;
  430. end
  431. else
  432. begin
  433. { Allocate UnixFindData }
  434. New(UnixFindData);
  435. FillChar(UnixFindData^,sizeof(UnixFindData^),0);
  436. Rslt.FindHandle:=UnixFindData;
  437. {Create Info}
  438. UnixFindData^.SearchSpec := Path;
  439. {We always also search for readonly and archive, regardless of Attr:}
  440. UnixFindData^.SearchAttr := Attr or faarchive or fareadonly;
  441. UnixFindData^.NamePos := Length(UnixFindData^.SearchSpec);
  442. while (UnixFindData^.NamePos>0) and (UnixFindData^.SearchSpec[UnixFindData^.NamePos]<>'/') do
  443. dec(UnixFindData^.NamePos);
  444. Result:=FindNext(Rslt);
  445. end;
  446. End;
  447. Function FileGetDate (Handle : Longint) : Longint;
  448. Var Info : Stat;
  449. begin
  450. If (fpFStat(Handle,Info))<0 then
  451. Result:=-1
  452. else
  453. Result:=Info.st_Mtime;
  454. end;
  455. Function FileSetDate (Handle,Age : Longint) : Longint;
  456. begin
  457. // Impossible under Linux from FileHandle !!
  458. FileSetDate:=-1;
  459. end;
  460. Function FileGetAttr (Const FileName : String) : Longint;
  461. Var Info : Stat;
  462. begin
  463. If FpStat (pointer(FileName),Info)<0 then
  464. Result:=-1
  465. Else
  466. Result:=LinuxToWinAttr(Pchar(ExtractFileName(FileName)),Info);
  467. end;
  468. Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
  469. begin
  470. Result:=-1;
  471. end;
  472. Function DeleteFile (Const FileName : String) : Boolean;
  473. begin
  474. Result:=fpUnLink (pointer(FileName))>=0;
  475. end;
  476. Function RenameFile (Const OldName, NewName : String) : Boolean;
  477. begin
  478. RenameFile:=BaseUnix.FpRename(pointer(OldNAme),pointer(NewName))>=0;
  479. end;
  480. Function FileIsReadOnly(const FileName: String): Boolean;
  481. begin
  482. Result := fpAccess(PChar(pointer(FileName)),W_OK)<>0;
  483. end;
  484. Function FileSetDate (Const FileName : String;Age : Longint) : Longint;
  485. var
  486. t: TUTimBuf;
  487. begin
  488. Result := 0;
  489. t.actime := Age;
  490. t.modtime := Age;
  491. if fputime(PChar(pointer(FileName)), @t) = -1 then
  492. Result := fpgeterrno;
  493. end;
  494. {****************************************************************************
  495. Disk Functions
  496. ****************************************************************************}
  497. {
  498. The Diskfree and Disksize functions need a file on the specified drive, since this
  499. is required for the statfs system call.
  500. These filenames are set in drivestr[0..26], and have been preset to :
  501. 0 - '.' (default drive - hence current dir is ok.)
  502. 1 - '/fd0/.' (floppy drive 1 - should be adapted to local system )
  503. 2 - '/fd1/.' (floppy drive 2 - should be adapted to local system )
  504. 3 - '/' (C: equivalent of dos is the root partition)
  505. 4..26 (can be set by you're own applications)
  506. ! Use AddDisk() to Add new drives !
  507. They both return -1 when a failure occurs.
  508. }
  509. Const
  510. FixDriveStr : array[0..3] of pchar=(
  511. '.',
  512. '/fd0/.',
  513. '/fd1/.',
  514. '/.'
  515. );
  516. var
  517. Drives : byte;
  518. DriveStr : array[4..26] of pchar;
  519. Function AddDisk(const path:string) : Byte;
  520. begin
  521. if not (DriveStr[Drives]=nil) then
  522. FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
  523. GetMem(DriveStr[Drives],length(Path)+1);
  524. StrPCopy(DriveStr[Drives],path);
  525. inc(Drives);
  526. if Drives>26 then
  527. Drives:=4;
  528. Result:=Drives;
  529. end;
  530. Function DiskFree(Drive: Byte): int64;
  531. var
  532. fs : tstatfs;
  533. Begin
  534. if ((Drive in [Low(FixDriveStr)..High(FixDriveStr)]) and (not (fixdrivestr[Drive]=nil)) and (statfs(StrPas(fixdrivestr[drive]),fs)<>-1)) or
  535. ((Drive <= High(drivestr)) and (not (drivestr[Drive]=nil)) and (statfs(StrPas(drivestr[drive]),fs)<>-1)) then
  536. Diskfree:=int64(fs.bavail)*int64(fs.bsize)
  537. else
  538. Diskfree:=-1;
  539. End;
  540. Function DiskSize(Drive: Byte): int64;
  541. var
  542. fs : tstatfs;
  543. Begin
  544. if ((Drive in [Low(FixDriveStr)..High(FixDriveStr)]) and (not (fixdrivestr[Drive]=nil)) and (statfs(StrPas(fixdrivestr[drive]),fs)<>-1)) or
  545. ((drive <= High(drivestr)) and (not (drivestr[Drive]=nil)) and (statfs(StrPas(drivestr[drive]),fs)<>-1)) then
  546. DiskSize:=int64(fs.blocks)*int64(fs.bsize)
  547. else
  548. DiskSize:=-1;
  549. End;
  550. Function GetCurrentDir : String;
  551. begin
  552. GetDir (0,Result);
  553. end;
  554. Function SetCurrentDir (Const NewDir : String) : Boolean;
  555. begin
  556. {$I-}
  557. ChDir(NewDir);
  558. {$I+}
  559. result := (IOResult = 0);
  560. end;
  561. Function CreateDir (Const NewDir : String) : Boolean;
  562. begin
  563. {$I-}
  564. MkDir(NewDir);
  565. {$I+}
  566. result := (IOResult = 0);
  567. end;
  568. Function RemoveDir (Const Dir : String) : Boolean;
  569. begin
  570. {$I-}
  571. RmDir(Dir);
  572. {$I+}
  573. result := (IOResult = 0);
  574. end;
  575. {****************************************************************************
  576. Misc Functions
  577. ****************************************************************************}
  578. procedure Beep;
  579. begin
  580. end;
  581. {****************************************************************************
  582. Locale Functions
  583. ****************************************************************************}
  584. Function GetEpochTime: cint;
  585. {
  586. Get the number of seconds since 00:00, January 1 1970, GMT
  587. the time NOT corrected any way
  588. }
  589. begin
  590. GetEpochTime:=fptime;
  591. end;
  592. procedure GetTime(var hour,min,sec,msec,usec:word);
  593. {
  594. Gets the current time, adjusted to local time
  595. }
  596. var
  597. year,day,month:Word;
  598. tz:timeval;
  599. begin
  600. fpgettimeofday(@tz,nil);
  601. EpochToLocal(tz.tv_sec,year,month,day,hour,min,sec);
  602. msec:=tz.tv_usec div 1000;
  603. usec:=tz.tv_usec mod 1000;
  604. end;
  605. procedure GetTime(var hour,min,sec,sec100:word);
  606. {
  607. Gets the current time, adjusted to local time
  608. }
  609. var
  610. usec : word;
  611. begin
  612. gettime(hour,min,sec,sec100,usec);
  613. sec100:=sec100 div 10;
  614. end;
  615. Procedure GetTime(Var Hour,Min,Sec:Word);
  616. {
  617. Gets the current time, adjusted to local time
  618. }
  619. var
  620. msec,usec : Word;
  621. Begin
  622. gettime(hour,min,sec,msec,usec);
  623. End;
  624. Procedure GetDate(Var Year,Month,Day:Word);
  625. {
  626. Gets the current date, adjusted to local time
  627. }
  628. var
  629. hour,minute,second : word;
  630. Begin
  631. EpochToLocal(fptime,year,month,day,hour,minute,second);
  632. End;
  633. Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
  634. {
  635. Gets the current date, adjusted to local time
  636. }
  637. Begin
  638. EpochToLocal(fptime,year,month,day,hour,minute,second);
  639. End;
  640. Procedure GetLocalTime(var SystemTime: TSystemTime);
  641. var
  642. usecs : Word;
  643. begin
  644. GetTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond, usecs);
  645. GetDate(SystemTime.Year, SystemTime.Month, SystemTime.Day);
  646. // SystemTime.MilliSecond := 0;
  647. end ;
  648. Procedure InitAnsi;
  649. Var
  650. i : longint;
  651. begin
  652. { Fill table entries 0 to 127 }
  653. for i := 0 to 96 do
  654. UpperCaseTable[i] := chr(i);
  655. for i := 97 to 122 do
  656. UpperCaseTable[i] := chr(i - 32);
  657. for i := 123 to 191 do
  658. UpperCaseTable[i] := chr(i);
  659. Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
  660. for i := 0 to 64 do
  661. LowerCaseTable[i] := chr(i);
  662. for i := 65 to 90 do
  663. LowerCaseTable[i] := chr(i + 32);
  664. for i := 91 to 191 do
  665. LowerCaseTable[i] := chr(i);
  666. Move (CPISO88591LCT,LowerCaseTable[192],SizeOf(CPISO88591UCT));
  667. end;
  668. Procedure InitInternational;
  669. begin
  670. InitInternationalGeneric;
  671. InitAnsi;
  672. end;
  673. function SysErrorMessage(ErrorCode: Integer): String;
  674. begin
  675. Result:=StrError(ErrorCode);
  676. end;
  677. {****************************************************************************
  678. OS utility functions
  679. ****************************************************************************}
  680. Function GetEnvironmentVariable(Const EnvVar : String) : String;
  681. begin
  682. Result:=StrPas(BaseUnix.FPGetenv(PChar(pointer(EnvVar))));
  683. end;
  684. Function GetEnvironmentVariableCount : Integer;
  685. begin
  686. Result:=FPCCountEnvVar(EnvP);
  687. end;
  688. Function GetEnvironmentString(Index : Integer) : String;
  689. begin
  690. Result:=FPCGetEnvStrFromP(Envp,Index);
  691. end;
  692. {$define FPC_USE_FPEXEC} // leave the old code under IFDEF for a while.
  693. function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
  694. var
  695. pid : longint;
  696. e : EOSError;
  697. CommandLine: AnsiString;
  698. cmdline2 : ppchar;
  699. Begin
  700. { always surround the name of the application by quotes
  701. so that long filenames will always be accepted. But don't
  702. do it if there are already double quotes!
  703. }
  704. {$ifdef FPC_USE_FPEXEC} // Only place we still parse
  705. cmdline2:=nil;
  706. if Comline<>'' Then
  707. begin
  708. CommandLine:=ComLine;
  709. { Make an unique copy because stringtoppchar modifies the
  710. string }
  711. UniqueString(CommandLine);
  712. cmdline2:=StringtoPPChar(CommandLine,1);
  713. cmdline2^:=pchar(pointer(Path));
  714. end
  715. else
  716. begin
  717. getmem(cmdline2,2*sizeof(pchar));
  718. cmdline2^:=pchar(Path);
  719. cmdline2[1]:=nil;
  720. end;
  721. {$else}
  722. if Pos ('"', Path) = 0 then
  723. CommandLine := '"' + Path + '"'
  724. else
  725. CommandLine := Path;
  726. if ComLine <> '' then
  727. CommandLine := Commandline + ' ' + ComLine;
  728. {$endif}
  729. {$ifdef USE_VFORK}
  730. pid:=fpvFork;
  731. {$else USE_VFORK}
  732. pid:=fpFork;
  733. {$endif USE_VFORK}
  734. if pid=0 then
  735. begin
  736. {The child does the actual exec, and then exits}
  737. {$ifdef FPC_USE_FPEXEC}
  738. fpexecv(pchar(pointer(Path)),Cmdline2);
  739. {$else}
  740. Execl(CommandLine);
  741. {$endif}
  742. { If the execve fails, we return an exitvalue of 127, to let it be known}
  743. fpExit(127);
  744. end
  745. else
  746. if pid=-1 then {Fork failed}
  747. begin
  748. e:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,-1]);
  749. e.ErrorCode:=-1;
  750. raise e;
  751. end;
  752. { We're in the parent, let's wait. }
  753. result:=WaitProcess(pid); // WaitPid and result-convert
  754. {$ifdef FPC_USE_FPEXEC}
  755. if Comline<>'' Then
  756. freemem(cmdline2);
  757. {$endif}
  758. if (result<0) or (result=127) then
  759. begin
  760. E:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,result]);
  761. E.ErrorCode:=result;
  762. Raise E;
  763. end;
  764. End;
  765. function ExecuteProcess(Const Path: AnsiString; Const ComLine: Array Of AnsiString):integer;
  766. var
  767. pid : longint;
  768. e : EOSError;
  769. Begin
  770. pid:=fpFork;
  771. if pid=0 then
  772. begin
  773. {The child does the actual exec, and then exits}
  774. fpexecl(Path,Comline);
  775. { If the execve fails, we return an exitvalue of 127, to let it be known}
  776. fpExit(127);
  777. end
  778. else
  779. if pid=-1 then {Fork failed}
  780. begin
  781. e:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,-1]);
  782. e.ErrorCode:=-1;
  783. raise e;
  784. end;
  785. { We're in the parent, let's wait. }
  786. result:=WaitProcess(pid); // WaitPid and result-convert
  787. if (result<0) or (result=127) then
  788. begin
  789. E:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,result]);
  790. E.ErrorCode:=result;
  791. raise E;
  792. end;
  793. End;
  794. procedure Sleep(milliseconds: Cardinal);
  795. Var
  796. timeout,timeoutresult : TTimespec;
  797. begin
  798. timeout.tv_sec:=milliseconds div 1000;
  799. timeout.tv_nsec:=1000*1000*(milliseconds mod 1000);
  800. fpnanosleep(@timeout,@timeoutresult);
  801. end;
  802. Function GetLastOSError : Integer;
  803. begin
  804. Result:=fpgetErrNo;
  805. end;
  806. { ---------------------------------------------------------------------
  807. Application config files
  808. ---------------------------------------------------------------------}
  809. Function GetHomeDir : String;
  810. begin
  811. Result:=GetEnvironmentVariable('HOME');
  812. If (Result<>'') then
  813. Result:=IncludeTrailingPathDelimiter(Result);
  814. end;
  815. { Follows base-dir spec,
  816. see [http://freedesktop.org/Standards/basedir-spec].
  817. Always ends with PathDelim. }
  818. Function XdgConfigHome : String;
  819. begin
  820. Result:=GetEnvironmentVariable('XDG_CONFIG_HOME');
  821. if (Result='') then
  822. Result:=GetHomeDir + '.config/'
  823. else
  824. Result:=IncludeTrailingPathDelimiter(Result);
  825. end;
  826. Function GetAppConfigDir(Global : Boolean) : String;
  827. begin
  828. If Global then
  829. Result:=IncludeTrailingPathDelimiter(SysConfigDir)
  830. else
  831. Result:=IncludeTrailingPathDelimiter(XdgConfigHome);
  832. if VendorName<>'' then
  833. Result:=IncludeTrailingPathDelimiter(Result+VendorName);
  834. Result:=IncludeTrailingPathDelimiter(Result+ApplicationName);
  835. end;
  836. Function GetAppConfigFile(Global : Boolean; SubDir : Boolean) : String;
  837. begin
  838. If Global then
  839. Result:=IncludeTrailingPathDelimiter(SysConfigDir)
  840. else
  841. Result:=IncludeTrailingPathDelimiter(XdgConfigHome);
  842. if SubDir then
  843. begin
  844. if VendorName<>'' then
  845. Result:=IncludeTrailingPathDelimiter(Result+VendorName);
  846. Result:=IncludeTrailingPathDelimiter(Result+ApplicationName);
  847. end;
  848. Result:=Result+ApplicationName+ConfigExtension;
  849. end;
  850. {****************************************************************************
  851. GetTempDir
  852. ****************************************************************************}
  853. Function GetTempDir(Global : Boolean) : String;
  854. begin
  855. If Assigned(OnGetTempDir) then
  856. Result:=OnGetTempDir(Global)
  857. else
  858. begin
  859. Result:=GetEnvironmentVariable('TEMP');
  860. If (Result='') Then
  861. Result:=GetEnvironmentVariable('TMP');
  862. if (Result='') then
  863. Result:='/tmp/' // fallback.
  864. end;
  865. if (Result<>'') then
  866. Result:=IncludeTrailingPathDelimiter(Result);
  867. end;
  868. {****************************************************************************
  869. GetUserDir
  870. ****************************************************************************}
  871. Var
  872. TheUserDir : String;
  873. Function GetUserDir : String;
  874. begin
  875. If (TheUserDir='') then
  876. begin
  877. TheUserDir:=GetEnvironmentVariable('HOME');
  878. if (TheUserDir<>'') then
  879. TheUserDir:=IncludeTrailingPathDelimiter(TheUserDir)
  880. else
  881. TheUserDir:=GetTempDir(False);
  882. end;
  883. Result:=TheUserDir;
  884. end;
  885. {****************************************************************************
  886. Initialization code
  887. ****************************************************************************}
  888. Initialization
  889. InitExceptions; { Initialize exceptions. OS independent }
  890. InitInternational; { Initialize internationalization settings }
  891. SysConfigDir:='/etc'; { Initialize system config dir }
  892. Finalization
  893. DoneExceptions;
  894. end.