sysutils.pp 25 KB

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