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