sysutils.pp 27 KB

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