sysutils.pp 27 KB

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