sysutils.pp 25 KB

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