Files.txt 39 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304
  1. MODULE HostFiles;
  2. (* THIS IS TEXT COPY OF linHostFiles.odc *)
  3. (* DO NOT EDIT *)
  4. IMPORT SYSTEM, Kernel, Files, LinLibc;
  5. CONST
  6. tempName = "odcxxxxx";
  7. docType = "odc";
  8. serverVersion = TRUE;
  9. pathLen* = 260;
  10. nofbufs = 4; (* max number of buffers per file *)
  11. bufsize = 2 * 1024; (* size of each buffer *)
  12. invalid = LinLibc.NULL;
  13. temp = 0; new = 1; shared = 2; hidden = 3; exclusive = 4; closed = 5; (* file states *)
  14. create = -1;
  15. ok = 0;
  16. invalidName = 1;
  17. invalidNameErr = MAX(INTEGER); (* On Windows this is 123 *)
  18. notFound = 2;
  19. fileNotFoundErr = LinLibc.ENOENT;
  20. pathNotFoundErr = LinLibc.ENOENT;
  21. existsAlready = 3;
  22. fileExistsErr = LinLibc.EEXIST;
  23. alreadyExistsErr = LinLibc.EEXIST; (* is alreadyExistsErr needed? *)
  24. writeProtected = 4;
  25. writeProtectedErr = LinLibc.EACCES;
  26. ioError = 5; (* same as LinLibc.EIO *)
  27. accessDenied = 6;
  28. accessDeniedErr = LinLibc.EACCES;
  29. sharingErr = LinLibc.EACCES;
  30. netAccessDeniedErr = LinLibc.EACCES;
  31. notEnoughMem = 80;
  32. notEnoughMemoryErr = LinLibc.ENOMEM;
  33. notEnoughDisk = 81;
  34. diskFullErr = LinLibc.EDQUOT;
  35. tooManyOpenFilesErr = LinLibc.EMFILE;
  36. noMoreFilesErr = 18;
  37. cancel = -8; retry = -9;
  38. TYPE
  39. FullName* = ARRAY pathLen OF CHAR;
  40. Locator* = POINTER TO RECORD (Files.Locator)
  41. path-: FullName; (* without trailing "/" *)
  42. maxLen-: INTEGER; (* maximum name length *)
  43. caseSens-: BOOLEAN; (* case sensitive file compares *)
  44. rootLen-: INTEGER (* for network version *)
  45. END;
  46. Buffer = POINTER TO RECORD
  47. dirty: BOOLEAN;
  48. org, len: INTEGER;
  49. data: ARRAY bufsize OF BYTE
  50. END;
  51. File = POINTER TO RECORD (Files.File)
  52. state: INTEGER;
  53. name: FullName;
  54. ref: LinLibc.PtrFILE;
  55. loc: Locator;
  56. swapper: INTEGER; (* index into file table / next buffer to swap *)
  57. len: INTEGER;
  58. bufs: ARRAY nofbufs OF Buffer;
  59. t: LONGINT (* time stamp of last file operation *)
  60. END;
  61. Reader = POINTER TO RECORD (Files.Reader)
  62. base: File;
  63. org, offset: INTEGER;
  64. buf: Buffer
  65. END;
  66. Writer = POINTER TO RECORD (Files.Writer)
  67. base: File;
  68. org, offset: INTEGER;
  69. buf: Buffer
  70. END;
  71. Directory = POINTER TO RECORD (Files.Directory)
  72. temp, startup: Locator
  73. END;
  74. Identifier = RECORD (Kernel.Identifier)
  75. name: FullName
  76. END;
  77. Searcher = RECORD (Kernel.Identifier)
  78. t0: INTEGER;
  79. f: File
  80. END;
  81. Counter = RECORD (Kernel.Identifier)
  82. count: INTEGER
  83. END;
  84. ShortName = ARRAY pathLen OF SHORTCHAR;
  85. VAR
  86. MapParamString*: PROCEDURE(in, p0, p1, p2: ARRAY OF CHAR; OUT out: ARRAY OF CHAR);
  87. appName-: FullName;
  88. dir: Directory;
  89. wildcard: Files.Type;
  90. startupDir: FullName;
  91. startupLen: INTEGER;
  92. res: INTEGER;
  93. (* debugging functions *)
  94. PROCEDURE Msg (IN str: ARRAY OF CHAR);
  95. VAR ss: ARRAY 1024 OF SHORTCHAR; res, l: INTEGER;
  96. BEGIN
  97. ss := SHORT(str);
  98. l := LEN(ss$);
  99. ss[l] := 0AX; ss[l + 1] := 0X;
  100. res := LinLibc.printf(ss);
  101. res := LinLibc.fflush(0)
  102. END Msg;
  103. PROCEDURE Int (x: LONGINT);
  104. VAR j, k: INTEGER; ch: CHAR; a, s: ARRAY 32 OF CHAR;
  105. BEGIN
  106. IF x # MIN(LONGINT) THEN
  107. IF x < 0 THEN s[0] := "-"; k := 1; x := -x ELSE k := 0 END;
  108. j := 0; REPEAT a[j] := CHR(x MOD 10 + ORD("0")); x := x DIV 10; INC(j) UNTIL x = 0
  109. ELSE
  110. a := "8085774586302733229"; s[0] := "-"; k := 1;
  111. j := 0; WHILE a[j] # 0X DO INC(j) END
  112. END;
  113. ASSERT(k + j < LEN(s), 20);
  114. REPEAT DEC(j); ch := a[j]; s[k] := ch; INC(k) UNTIL j = 0;
  115. s[k] := 0X;
  116. Msg(s);
  117. END Int;
  118. (* end of debugging functions *)
  119. (* get error num from linux *)
  120. PROCEDURE LinLibc_errno (): INTEGER;
  121. VAR
  122. addr, errno: INTEGER;
  123. BEGIN
  124. addr := LinLibc.__errno_location();
  125. SYSTEM.GET(addr, errno);
  126. RETURN errno
  127. END LinLibc_errno;
  128. PROCEDURE Error (n: INTEGER): INTEGER;
  129. VAR res: INTEGER;
  130. BEGIN
  131. IF n = ok THEN res := ok
  132. ELSIF n = invalidNameErr THEN res := invalidName
  133. ELSIF (n = fileNotFoundErr) OR (n = pathNotFoundErr) THEN res := notFound
  134. ELSIF (n = fileExistsErr) OR (n = alreadyExistsErr) THEN res := existsAlready
  135. ELSIF n = writeProtectedErr THEN res := writeProtected
  136. ELSIF (n = sharingErr) OR (n = accessDeniedErr) OR (n = netAccessDeniedErr) THEN res := accessDenied
  137. ELSIF n = notEnoughMemoryErr THEN res := notEnoughMem
  138. ELSIF (n = diskFullErr) OR (n = tooManyOpenFilesErr) THEN res := notEnoughDisk
  139. ELSE res := -n
  140. END;
  141. RETURN res
  142. END Error;
  143. PROCEDURE Diff (VAR a, b: ARRAY OF CHAR; caseSens: BOOLEAN): INTEGER;
  144. VAR i: INTEGER; cha, chb: CHAR;
  145. BEGIN
  146. i := 0;
  147. REPEAT
  148. cha := a[i]; chb := b[i]; INC(i);
  149. IF cha # chb THEN
  150. IF ~caseSens THEN
  151. IF (cha >= "a") & ((cha <= "z") OR (cha >= 0E0X) & (cha <= 0FEX) & (cha # 0F7X)) THEN
  152. cha := CAP(cha)
  153. END;
  154. IF (chb >= "a") & ((chb <= "z") OR (chb >= 0E0X) & (chb <= 0FEX) & (chb # 0F7X)) THEN
  155. chb := CAP(chb)
  156. END
  157. END;
  158. IF cha = "\" THEN cha := "/" END;
  159. IF chb = "\" THEN chb := "/" END;
  160. IF cha # chb THEN RETURN ORD(cha) - ORD(chb) END
  161. END
  162. UNTIL cha = 0X;
  163. RETURN 0
  164. END Diff;
  165. PROCEDURE Stat (IN fname: FullName; VAR buf: LinLibc.stat_t; OUT res: INTEGER);
  166. VAR s: ShortName;
  167. BEGIN
  168. s := SHORT(fname);
  169. res := LinLibc.__xstat(3, s, buf); (* macro expansion of "stat" *)
  170. END Stat;
  171. PROCEDURE ModeToAttr (mode: SET; OUT attr: SET; OUT isDir: BOOLEAN);
  172. CONST read = 8; write = 7; execute = 6; file = 15; (* bits for permissions for the current user (see man chmod) *)
  173. BEGIN
  174. attr := {};
  175. IF ~(write IN mode) THEN INCL(attr, Files.readOnly) END;
  176. isDir := ~(file IN mode) (* see "man 2 stat" for details *)
  177. END ModeToAttr;
  178. PROCEDURE NewLocator* (IN fname: ARRAY OF CHAR): Locator;
  179. VAR loc: Locator; i: INTEGER;
  180. BEGIN
  181. NEW(loc); loc.path := fname$; i := 0;
  182. WHILE loc.path[i] # 0X DO INC(i) END;
  183. IF (loc.path[i-1] = "/") OR (loc.path[i-1] = "\") THEN loc.path[i-1] := 0X END;
  184. loc.maxLen := LinLibc.NAME_MAX; loc.caseSens := TRUE;
  185. RETURN loc
  186. END NewLocator;
  187. PROCEDURE GetType (IN name: ARRAY OF CHAR; VAR type: Files.Type);
  188. VAR i, j: INTEGER; ch: CHAR;
  189. BEGIN
  190. i := 0; j := 0;
  191. WHILE name[i] # 0X DO INC(i) END;
  192. WHILE (i > 0) & (name[i] # ".") DO DEC(i) END;
  193. IF i > 0 THEN
  194. INC(i); ch := name[i];
  195. WHILE (j < LEN(type) - 1) & (ch # 0X) DO
  196. IF (ch >= "A") & (ch <= "Z") THEN ch := CHR(ORD(ch) + (ORD("a") - ORD("A"))) END;
  197. type[j] := ch; INC(j);
  198. INC(i); ch := name[i]
  199. END
  200. END;
  201. type[j] := 0X
  202. END GetType;
  203. PROCEDURE Append (IN path, name: ARRAY OF CHAR; type: Files.Type; max: INTEGER;
  204. VAR res: ARRAY OF CHAR
  205. );
  206. VAR i, j, n, m, dot: INTEGER; ch: CHAR;
  207. BEGIN
  208. i := 0;
  209. WHILE path[i] # 0X DO res[i] := path[i]; INC(i) END;
  210. IF path # "" THEN
  211. ASSERT((res[i-1] # "/") & (res[i-1] # "\"), 100);
  212. res[i] := "/"; INC(i)
  213. END;
  214. j := 0; ch := name[0]; n := 0; m := max; dot := -1;
  215. IF max = 12 THEN m := 8 END;
  216. WHILE (i < LEN(res) - 1) & (ch # 0X) DO
  217. IF (ch = "/") OR (ch = "\") THEN
  218. res[i] := ch; INC(i); n := 0; m := max; dot := -1;
  219. IF max = 12 THEN m := 8 END
  220. ELSIF (n < m) OR (ch = ".") & (n = 8) THEN
  221. res[i] := ch; INC(i); INC(n);
  222. IF ch = "." THEN dot := n;
  223. IF max = 12 THEN m := n + 3 END
  224. END
  225. END;
  226. INC(j); ch := name[j]
  227. END;
  228. IF (dot = -1) & (type # "") THEN
  229. IF max = 12 THEN m := n + 4 END;
  230. IF (n < m) & (i < LEN(res) - 1) THEN res[i] := "."; INC(i); INC(n); dot := n END
  231. END;
  232. IF n = dot THEN j := 0;
  233. WHILE (n < m) & (i < LEN(res) - 1) & (type[j] # 0X) DO res[i] := type[j]; INC(i); INC(j) END
  234. END;
  235. res[i] := 0X
  236. END Append;
  237. PROCEDURE CloseFileHandle (f: File; VAR res: INTEGER);
  238. BEGIN
  239. IF (f.ref = invalid) OR (LinLibc.fclose(f.ref) = 0) THEN res := ok (* !!! *)
  240. ELSE res := LinLibc_errno()
  241. END;
  242. f.ref := invalid
  243. END CloseFileHandle;
  244. PROCEDURE CloseFile (f: File; VAR res: INTEGER);
  245. VAR s: INTEGER; n: ShortName;
  246. BEGIN
  247. IF f.state = exclusive THEN
  248. f.Flush;
  249. res := LinLibc.fflush(f.ref)
  250. END;
  251. s := f.state; f.state := closed;
  252. CloseFileHandle (f, res);
  253. IF (s IN {temp, new, hidden}) & (f.name # "") THEN
  254. n := SHORT(f.name$);
  255. res := LinLibc.remove(n)
  256. END
  257. END CloseFile;
  258. PROCEDURE (f: File) FINALIZE;
  259. VAR res: INTEGER;
  260. BEGIN
  261. IF f.state # closed THEN CloseFile(f, res) END
  262. END FINALIZE;
  263. PROCEDURE (VAR id: Identifier) Identified (): BOOLEAN;
  264. VAR f: File;
  265. BEGIN
  266. f := id.obj(File);
  267. RETURN (f.state IN {shared, exclusive}) & (Diff(f.name, id.name, f.loc.caseSens) = 0)
  268. END Identified;
  269. PROCEDURE ThisFile (VAR name: FullName): File;
  270. VAR id: Identifier; p: ANYPTR;
  271. BEGIN
  272. id.typ := SYSTEM.TYP(File); id.name := name$;
  273. p := Kernel.ThisFinObj(id);
  274. IF p # NIL THEN RETURN p(File)
  275. ELSE RETURN NIL
  276. END
  277. END ThisFile;
  278. PROCEDURE (VAR s: Searcher) Identified (): BOOLEAN;
  279. VAR f: File;
  280. BEGIN
  281. f := s.obj(File);
  282. IF (f.ref # invalid) & ((s.f = NIL) OR (f.t < s.f.t)) THEN s.f := f END;
  283. RETURN FALSE
  284. END Identified;
  285. PROCEDURE SearchFileToClose;
  286. VAR s: Searcher; p: ANYPTR; (* res: LONGINT; *)
  287. BEGIN
  288. s.typ := SYSTEM.TYP(File); s.f := NIL;
  289. p := Kernel.ThisFinObj(s);
  290. IF s.f # NIL THEN
  291. res := LinLibc.fclose(s.f.ref); s.f.ref := invalid;
  292. IF res = 0 THEN res := LinLibc_errno(); HALT(100) END
  293. END
  294. END SearchFileToClose;
  295. PROCEDURE ExistingFile (VAR n: ShortName): BOOLEAN;
  296. VAR f: LinLibc.PtrFILE; ret: BOOLEAN; res: INTEGER;
  297. BEGIN
  298. f := LinLibc.fopen(n, "r");
  299. IF f # LinLibc.NULL THEN
  300. res := LinLibc.fclose(f);
  301. ret := TRUE
  302. ELSE
  303. ret := FALSE
  304. END;
  305. RETURN ret
  306. END ExistingFile;
  307. PROCEDURE MoveFile (VAR old, new: ShortName; VAR res: INTEGER); (* as the WinApi.MoveFile *)
  308. BEGIN
  309. IF ExistingFile(new) THEN
  310. res := fileExistsErr
  311. ELSE
  312. IF LinLibc.rename(old, new) = 0 THEN res := ok
  313. ELSE res := LinLibc_errno();
  314. END
  315. END
  316. END MoveFile;
  317. PROCEDURE NewFileRef (state: INTEGER; VAR name: FullName; VAR ref, res: INTEGER);
  318. VAR n: ShortName;
  319. BEGIN
  320. n := SHORT(name$);
  321. IF state = create THEN (* Create should fail if file already exists *)
  322. IF ExistingFile(n) THEN
  323. ref := invalid; res := fileExistsErr
  324. ELSE
  325. ref := LinLibc.fopen(n, "w+");
  326. IF ref = invalid THEN res := LinLibc_errno() ELSE res := ok END
  327. END
  328. ELSIF state = shared THEN
  329. ref := LinLibc.fopen(n, "r");
  330. IF ref = invalid THEN res := LinLibc_errno() ELSE res := ok END
  331. ELSE
  332. ref := LinLibc.fopen(n, "r+");
  333. IF ref = invalid THEN res := LinLibc_errno() ELSE res := ok END
  334. END
  335. END NewFileRef;
  336. PROCEDURE OpenFile (state: INTEGER; VAR name: FullName; VAR ref, res: INTEGER);
  337. BEGIN
  338. NewFileRef(state, name, ref, res);
  339. IF ref = invalid THEN
  340. IF res = tooManyOpenFilesErr THEN
  341. Kernel.Collect;
  342. NewFileRef(state, name, ref, res);
  343. IF ref = invalid THEN
  344. res := LinLibc_errno();
  345. IF res = tooManyOpenFilesErr THEN
  346. SearchFileToClose;
  347. NewFileRef(state, name, ref, res);
  348. END
  349. ELSE res := ok
  350. END
  351. END
  352. ELSE res := ok
  353. END
  354. END OpenFile;
  355. PROCEDURE GetTempFileName (VAR path, name: FullName; num: INTEGER);
  356. VAR i: INTEGER; str: ARRAY 16 OF CHAR;
  357. BEGIN
  358. str := tempName; i := 7;
  359. WHILE i > 2 DO
  360. str[i] := CHR(num MOD 10 + ORD("0")); DEC(i); num := num DIV 10
  361. END;
  362. Append(path, str, "", 8, name)
  363. END GetTempFileName;
  364. PROCEDURE CreateFile (f: File; VAR res: INTEGER);
  365. VAR num, n: INTEGER;
  366. BEGIN
  367. IF f.name = "" THEN
  368. num := LinLibc.clock(); n := 200;
  369. REPEAT
  370. GetTempFileName(f.loc.path, f.name, num); INC(num); DEC(n);
  371. OpenFile(create, f.name, f.ref, res)
  372. UNTIL (res # fileExistsErr) OR (n = 0)
  373. ELSE
  374. OpenFile(f.state, f.name, f.ref, res)
  375. END
  376. END CreateFile;
  377. PROCEDURE Delete (VAR fname, path: FullName; VAR res: INTEGER);
  378. VAR num, n: INTEGER; f: File; new: FullName; attr: SET; fn, nn: ShortName; buf: LinLibc.stat_t; isDir: BOOLEAN;
  379. BEGIN
  380. ASSERT(fname # "", 100);
  381. f := ThisFile(fname); fn := SHORT(fname$);
  382. IF f = NIL THEN
  383. IF LinLibc.remove(fn) = 0 THEN
  384. res := ok
  385. ELSE
  386. res := LinLibc.fflush(0);
  387. IF LinLibc.remove(fn) = 0 THEN res := ok ELSE res := LinLibc_errno() END
  388. END
  389. ELSE (* still in use => make it anonymous *)
  390. IF f.ref # invalid THEN res := LinLibc.fclose(f.ref); f.ref := invalid END; (* !!! *)
  391. Stat(f.name, buf, res);
  392. ModeToAttr(buf.st_mode, attr, isDir);
  393. IF (res = ok) & ~(Files.readOnly IN attr) THEN
  394. num := LinLibc.clock(); n := 200;
  395. REPEAT
  396. GetTempFileName(path, new, num); INC(num); DEC(n);
  397. nn := SHORT(new$);
  398. MoveFile(fn, nn, res);
  399. UNTIL (res # fileExistsErr) OR (n = 0);
  400. IF res = ok THEN
  401. f.state := hidden; f.name := new$
  402. END
  403. ELSE
  404. res := writeProtectedErr
  405. END
  406. END
  407. END Delete;
  408. PROCEDURE FlushBuffer (f: File; i: INTEGER);
  409. VAR buf: Buffer; res: INTEGER;
  410. BEGIN
  411. buf := f.bufs[i];
  412. IF (buf # NIL) & buf.dirty THEN
  413. IF f.ref = invalid THEN CreateFile(f, res) (* ASSERT(res = ok, 100) *) END;
  414. IF f.ref # invalid THEN
  415. res := LinLibc.fseek(f.ref, buf.org, LinLibc.SEEK_SET);
  416. IF LinLibc.fwrite(SYSTEM.ADR(buf.data), 1, buf.len, f.ref) < buf.len THEN
  417. res := LinLibc_errno(); HALT(101)
  418. END;
  419. res := LinLibc.fflush(f.ref);
  420. buf.dirty := FALSE; f.t := Kernel.Time()
  421. END
  422. END
  423. END FlushBuffer;
  424. (* File *)
  425. PROCEDURE (f: File) NewReader (old: Files.Reader): Files.Reader;
  426. VAR r: Reader;
  427. BEGIN (* portable *)
  428. ASSERT(f.state # closed, 20);
  429. IF (old # NIL) & (old IS Reader) THEN r := old(Reader) ELSE NEW(r) END;
  430. IF r.base # f THEN
  431. r.base := f; r.buf := NIL; r.SetPos(0)
  432. END;
  433. r.eof := FALSE;
  434. RETURN r
  435. END NewReader;
  436. PROCEDURE (f: File) NewWriter (old: Files.Writer): Files.Writer;
  437. VAR w: Writer;
  438. BEGIN (* portable *)
  439. ASSERT(f.state # closed, 20);
  440. IF (old # NIL) & (old IS Writer) THEN w := old(Writer) ELSE NEW(w) END;
  441. IF w.base # f THEN
  442. w.base := f; w.buf := NIL; w.SetPos(f.len)
  443. END;
  444. RETURN w
  445. END NewWriter;
  446. PROCEDURE (f: File) Length (): INTEGER;
  447. BEGIN (* portable *)
  448. RETURN f.len
  449. END Length;
  450. PROCEDURE (f: File) Flush;
  451. VAR i: INTEGER;
  452. BEGIN (* portable *)
  453. i := 0; WHILE i # nofbufs DO FlushBuffer(f, i); INC(i) END
  454. END Flush;
  455. PROCEDURE GetPath (VAR fname, path: FullName);
  456. VAR i: INTEGER;
  457. BEGIN
  458. path := fname$; i := 0;
  459. WHILE path[i] # 0X DO INC(i) END;
  460. WHILE (i > 0) & (path[i] # "\") & (path[i] # "/") & (path[i-1] # ":") DO DEC(i) END;
  461. path[i] := 0X
  462. END GetPath;
  463. PROCEDURE CreateDir (VAR path: FullName; VAR res: INTEGER);
  464. VAR (*sec: KERNEL32.SecurityAttributes;*) p: FullName; s: ShortName;
  465. BEGIN
  466. ASSERT(path # "", 100);
  467. s := SHORT(path$);
  468. res := LinLibc.mkdir(s, {0..MAX(SET)}); (* full rights are masked with the umask, is this correct? *)
  469. IF res # ok THEN
  470. res := LinLibc_errno();
  471. IF (res = LinLibc.ENOTDIR) OR (res = LinLibc.ENOENT) THEN
  472. GetPath(path, p);
  473. CreateDir(p, res); (* recursive call *)
  474. IF res = ok THEN
  475. res := LinLibc.mkdir(s, {0..MAX(SET)}); (* full rights are masked with the umask, is this correct? *)
  476. IF res # ok THEN res := LinLibc_errno() END
  477. END
  478. END
  479. END
  480. END CreateDir;
  481. PROCEDURE CheckPath (VAR path: FullName; ask: BOOLEAN; VAR res: INTEGER);
  482. VAR s: ARRAY 300 OF CHAR; t: ARRAY 32 OF CHAR;
  483. BEGIN
  484. (*IF ask THEN
  485. IF MapParamString # NIL THEN
  486. MapParamString("#Host:CreateDir", path, "", "", s);
  487. MapParamString("#Host:MissingDirectory", "", "", "", t)
  488. ELSE
  489. s := path$; t := "Missing Directory"
  490. END;
  491. res := Kernel.MessageBox(t, s, {Kernel.mbOk, Kernel.mbCancel})
  492. ELSE
  493. res := Kernel.mbOk
  494. END;*)
  495. (*IF res = Kernel.mbOk THEN*) CreateDir(path, res)
  496. (*ELSIF res = Kernel.mbCancel THEN res := cancel
  497. END*)
  498. END CheckPath;
  499. PROCEDURE CheckDelete (VAR fname, path: FullName; ask: BOOLEAN; VAR res: INTEGER);
  500. VAR s: ARRAY 300 OF CHAR; t: ARRAY 16 OF CHAR;
  501. BEGIN
  502. REPEAT
  503. Delete(fname, path, res);
  504. IF (res = writeProtectedErr)
  505. OR (res = sharingErr)
  506. OR (res = accessDeniedErr)
  507. OR (res = netAccessDeniedErr)
  508. THEN
  509. (*IF ask THEN
  510. IF MapParamString # NIL THEN
  511. IF res = writeProtectedErr THEN
  512. MapParamString("#Host:ReplaceWriteProtected", fname, 0DX, "", s)
  513. ELSIF (res = accessDeniedErr) OR (res = netAccessDeniedErr) THEN
  514. MapParamString("#Host:ReplaceAccessDenied", fname, 0DX, "", s)
  515. ELSE
  516. MapParamString("#Host:ReplaceInUse", fname, 0DX, "", s)
  517. END;
  518. MapParamString("#Host:FileError", "", "", "", t)
  519. ELSE
  520. s := fname$; t := "File Error"
  521. END;
  522. res := Kernel.MessageBox(t, s, {Kernel.mbRetry, Kernel.mbCancel});
  523. IF res = Kernel.mbCancel THEN res := cancel
  524. ELSIF res = Kernel.mbRetry THEN res := retry
  525. END
  526. ELSE*)
  527. res := cancel
  528. (*END*)
  529. ELSE
  530. res := ok
  531. END
  532. UNTIL res # retry
  533. END CheckDelete;
  534. PROCEDURE (f: File) Register (name: Files.Name; type: Files.Type; ask: BOOLEAN; OUT res: INTEGER);
  535. VAR b: INTEGER; fname: FullName; fn, nn: ShortName;
  536. BEGIN
  537. ASSERT(f.state = new, 20); ASSERT(name # "", 21);
  538. Append(f.loc.path, name, type, f.loc.maxLen, fname);
  539. CheckDelete(fname, f.loc.path, ask, res);
  540. ASSERT(res # 87, 100);
  541. IF res = ok THEN
  542. IF f.name = "" THEN
  543. f.name := fname$;
  544. OpenFile(create, f.name, f.ref, res);
  545. IF res = ok THEN
  546. f.state := exclusive; CloseFile(f, res);
  547. fn := SHORT(f.name$);
  548. END
  549. ELSE
  550. f.state := exclusive; CloseFile(f, res);
  551. fn := SHORT(f.name$); nn := SHORT(fname$);
  552. MoveFile(fn, nn, res);
  553. IF res = ok THEN
  554. f.name := fname$;
  555. fn := SHORT(f.name$);
  556. ELSE
  557. ASSERT(res # 87, 101);
  558. fn := SHORT(f.name$);
  559. b := LinLibc.remove(fn);
  560. END
  561. END
  562. END;
  563. res := Error(res)
  564. END Register;
  565. PROCEDURE (f: File) Close;
  566. VAR res: INTEGER;
  567. BEGIN (* portable *)
  568. IF f.state # closed THEN
  569. IF f.state = exclusive THEN
  570. CloseFile(f, res)
  571. ELSE
  572. CloseFileHandle(f, res)
  573. END
  574. END
  575. END Close;
  576. (* Locator *)
  577. PROCEDURE (loc: Locator) This* (IN path: ARRAY OF CHAR): Locator;
  578. VAR new: Locator; i: INTEGER;
  579. BEGIN
  580. IF path = "" THEN
  581. NEW(new); new^ := loc^
  582. ELSIF path[0] = "/" THEN (* absolute path *)
  583. new := NewLocator(path);
  584. new.rootLen := 0
  585. ELSIF (path[0] = "\") OR (path[0] = "/") THEN
  586. IF (path[1] = "\") OR (path[1] = "/") THEN (* network path *)
  587. new := NewLocator(path);
  588. new.rootLen := 0
  589. ELSE
  590. NEW(new); new^ := dir.startup^;
  591. new.res := invalidName;
  592. RETURN new
  593. END
  594. ELSE
  595. NEW(new); Append(loc.path, path, "", loc.maxLen, new.path);
  596. i := 0; WHILE new.path[i] # 0X DO INC(i) END;
  597. IF (new.path[i-1] = "/") OR (new.path[i-1] = "\") THEN new.path[i-1] := 0X END;
  598. new.maxLen := loc.maxLen;
  599. new.caseSens := loc.caseSens;
  600. new.rootLen := loc.rootLen
  601. END;
  602. new.res := ok;
  603. RETURN new
  604. END This;
  605. (* Reader *)
  606. PROCEDURE (r: Reader) Base (): Files.File;
  607. BEGIN (* portable *)
  608. RETURN r.base
  609. END Base;
  610. PROCEDURE (r: Reader) SetPos (pos: INTEGER);
  611. VAR f: File; org, offset, i, count, res: INTEGER; buf: Buffer;
  612. BEGIN
  613. f := r.base; ASSERT(f # NIL, 20); ASSERT(f.state # closed, 25);
  614. ASSERT(pos >= 0, 22); ASSERT(pos <= f.len, 21);
  615. offset := pos MOD bufsize; org := pos - offset;
  616. i := 0; WHILE (i # nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END;
  617. IF i # nofbufs THEN
  618. buf := f.bufs[i];
  619. IF buf = NIL THEN (* create new buffer *)
  620. NEW(buf); f.bufs[i] := buf; buf.org := -1
  621. END
  622. ELSE (* choose an existing buffer *)
  623. f.swapper := (f.swapper + 1) MOD nofbufs;
  624. FlushBuffer(f, f.swapper); buf := f.bufs[f.swapper]; buf.org := -1
  625. END;
  626. IF buf.org # org THEN
  627. IF org + bufsize > f.len THEN buf.len := f.len - org ELSE buf.len := bufsize END;
  628. count := buf.len;
  629. IF count > 0 THEN
  630. IF f.ref = invalid THEN CreateFile(f, res) (* ASSERT(res = ok, 100) *) END;
  631. IF f.ref # invalid THEN
  632. IF LinLibc.fseek(f.ref, org, LinLibc.SEEK_SET) # 0 THEN
  633. res := LinLibc_errno(); HALT(101)
  634. END;
  635. IF LinLibc.fread(SYSTEM.ADR(buf.data), 1, count, f.ref) < count THEN
  636. res := LinLibc_errno(); HALT(102)
  637. END;
  638. f.t := Kernel.Time()
  639. END
  640. END;
  641. buf.org := org; buf.dirty := FALSE
  642. END;
  643. r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE
  644. (* 0<= r.org <= r.base.len *)
  645. (* 0 <= r.offset < bufsize *)
  646. (* 0 <= r.buf.len <= bufsize *)
  647. (* r.offset <= r.base.len *)
  648. (* r.offset <= r.buf.len *)
  649. END SetPos;
  650. PROCEDURE (r: Reader) Pos (): INTEGER;
  651. BEGIN (* portable *)
  652. ASSERT(r.base # NIL, 20);
  653. RETURN r.org + r.offset
  654. END Pos;
  655. PROCEDURE (r: Reader) ReadByte (OUT x: BYTE);
  656. BEGIN (* portable *)
  657. IF (r.org # r.buf.org) OR (r.offset >= bufsize) THEN r.SetPos(r.org + r.offset) END;
  658. IF r.offset < r.buf.len THEN
  659. x := r.buf.data[r.offset]; INC(r.offset)
  660. ELSE
  661. x := 0; r.eof := TRUE
  662. END
  663. END ReadByte;
  664. PROCEDURE (r: Reader) ReadBytes (VAR x: ARRAY OF BYTE; beg, len: INTEGER);
  665. VAR from, to, count, restInBuf: INTEGER;
  666. BEGIN (* portable *)
  667. ASSERT(beg >= 0, 21);
  668. IF len > 0 THEN
  669. ASSERT(beg + len <= LEN(x), 23);
  670. WHILE len # 0 DO
  671. IF (r.org # r.buf.org) OR (r.offset >= bufsize) THEN r.SetPos(r.org + r.offset) END;
  672. restInBuf := r.buf.len - r.offset;
  673. IF restInBuf = 0 THEN r.eof := TRUE; RETURN
  674. ELSIF restInBuf <= len THEN count := restInBuf
  675. ELSE count := len
  676. END;
  677. from := SYSTEM.ADR(r.buf.data[r.offset]); to := SYSTEM.ADR(x) + beg;
  678. SYSTEM.MOVE(from, to, count);
  679. INC(r.offset, count); INC(beg, count); DEC(len, count)
  680. END;
  681. r.eof := FALSE
  682. ELSE ASSERT(len = 0, 22)
  683. END
  684. END ReadBytes;
  685. (* Writer *)
  686. PROCEDURE (w: Writer) Base (): Files.File;
  687. BEGIN (* portable *)
  688. RETURN w.base
  689. END Base;
  690. PROCEDURE (w: Writer) SetPos (pos: INTEGER);
  691. VAR f: File; org, offset, i, count, res: INTEGER; buf: Buffer;
  692. BEGIN
  693. f := w.base; ASSERT(f # NIL, 20); ASSERT(f.state # closed, 25);
  694. ASSERT(pos >= 0, 22); ASSERT(pos <= f.len, 21);
  695. offset := pos MOD bufsize; org := pos - offset;
  696. i := 0; WHILE (i # nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END;
  697. IF i # nofbufs THEN
  698. buf := f.bufs[i];
  699. IF buf = NIL THEN (* create new buffer *)
  700. NEW(buf); f.bufs[i] := buf; buf.org := -1
  701. END
  702. ELSE (* choose an existing buffer *)
  703. f.swapper := (f.swapper + 1) MOD nofbufs;
  704. FlushBuffer(f, f.swapper); buf := f.bufs[f.swapper]; buf.org := -1
  705. END;
  706. IF buf.org # org THEN
  707. IF org + bufsize > f.len THEN buf.len := f.len - org ELSE buf.len := bufsize END;
  708. count := buf.len;
  709. IF count > 0 THEN
  710. IF f.ref = invalid THEN CreateFile(f, res) (* ASSERT(res = ok, 100) *) END;
  711. IF f.ref # invalid THEN
  712. IF LinLibc.fseek(f.ref, org, LinLibc.SEEK_SET) # 0 THEN
  713. res := LinLibc_errno(); HALT(101)
  714. END;
  715. IF LinLibc.fread(SYSTEM.ADR(buf.data), 1, count, f.ref) < count THEN
  716. res := LinLibc_errno(); HALT(102)
  717. END;
  718. f.t := Kernel.Time()
  719. END
  720. END;
  721. buf.org := org; buf.dirty := FALSE
  722. END;
  723. w.buf := buf; w.org := org; w.offset := offset
  724. (* 0<= w.org <= w.base.len *)
  725. (* 0 <= w.offset < bufsize *)
  726. (* 0 <= w.buf.len <= bufsize *)
  727. (* w.offset <= w.base.len *)
  728. (* w.offset <= w.buf.len *)
  729. END SetPos;
  730. PROCEDURE (w: Writer) Pos (): INTEGER;
  731. BEGIN (* portable *)
  732. ASSERT(w.base # NIL, 20);
  733. RETURN w.org + w.offset
  734. END Pos;
  735. PROCEDURE (w: Writer) WriteByte (x: BYTE);
  736. BEGIN (* portable *)
  737. ASSERT(w.base.state # closed, 25);
  738. IF (w.org # w.buf.org) OR (w.offset >= bufsize) THEN w.SetPos(w.org + w.offset) END;
  739. w.buf.data[w.offset] := x; w.buf.dirty := TRUE;
  740. IF w.offset = w.buf.len THEN INC(w.buf.len); INC(w.base.len) END;
  741. INC(w.offset)
  742. END WriteByte;
  743. PROCEDURE (w: Writer) WriteBytes (IN x: ARRAY OF BYTE; beg, len: INTEGER);
  744. VAR from, to, count, restInBuf: INTEGER;
  745. BEGIN (* portable *)
  746. ASSERT(beg >= 0, 21); ASSERT(w.base.state # closed, 25);
  747. IF len > 0 THEN
  748. ASSERT(beg + len <= LEN(x), 23);
  749. WHILE len # 0 DO
  750. IF (w.org # w.buf.org) OR (w.offset >= bufsize) THEN w.SetPos(w.org + w.offset) END;
  751. restInBuf := bufsize - w.offset;
  752. IF restInBuf <= len THEN count := restInBuf ELSE count := len END;
  753. from := SYSTEM.ADR(x) + beg; to := SYSTEM.ADR(w.buf.data[w.offset]);
  754. SYSTEM.MOVE(from, to, count);
  755. INC(w.offset, count); INC(beg, count); DEC(len, count);
  756. IF w.offset > w.buf.len THEN INC(w.base.len, w.offset - w.buf.len); w.buf.len := w.offset END;
  757. w.buf.dirty := TRUE
  758. END
  759. ELSE ASSERT(len = 0, 22)
  760. END
  761. END WriteBytes;
  762. (* Directory *)
  763. PROCEDURE (d: Directory) This (IN path: ARRAY OF CHAR): Files.Locator;
  764. BEGIN
  765. RETURN d.startup.This(path)
  766. END This;
  767. PROCEDURE (d: Directory) New (loc: Files.Locator; ask: BOOLEAN): Files.File;
  768. VAR f: File; res: INTEGER; attr: SET; isDir: BOOLEAN; buf: LinLibc.stat_t;
  769. BEGIN
  770. ASSERT(loc # NIL, 20); f := NIL; res := ok;
  771. WITH loc: Locator DO
  772. IF loc.path # "" THEN
  773. Stat(loc.path, buf, res);
  774. IF res # ok THEN
  775. IF loc.res = 76 THEN CreateDir(loc.path, res)
  776. ELSE CheckPath(loc.path, ask, res)
  777. END
  778. ELSE
  779. ModeToAttr(buf.st_mode, attr, isDir);
  780. IF ~isDir THEN res := fileExistsErr END
  781. END
  782. END;
  783. IF res = ok THEN
  784. NEW(f); f.loc := loc; f.name := "";
  785. f.state := new; f.swapper := -1; f.len := 0; f.ref := invalid
  786. END
  787. ELSE res := invalidNameErr
  788. END;
  789. loc.res := Error(res);
  790. RETURN f
  791. END New;
  792. PROCEDURE (d: Directory) Temp (): Files.File;
  793. VAR f: File;
  794. BEGIN
  795. NEW(f); f.loc := d.temp; f.name := "";
  796. f.state := temp; f.swapper := -1; f.len := 0; f.ref := invalid;
  797. RETURN f
  798. END Temp;
  799. PROCEDURE GetShadowDir (loc: Locator; OUT dir: FullName);
  800. VAR i, j: INTEGER;
  801. BEGIN
  802. dir := startupDir$; i := startupLen; j := loc.rootLen;
  803. WHILE loc.path[j] # 0X DO dir[i] := loc.path[j]; INC(i); INC(j) END;
  804. dir[i] := 0X
  805. END GetShadowDir;
  806. PROCEDURE (d: Directory) Old (loc: Files.Locator; name: Files.Name; shrd: BOOLEAN): Files.File;
  807. VAR res: INTEGER; f: File; ref: LinLibc.PtrFILE; fname: FullName; type: Files.Type; s: BYTE; buf: LinLibc.stat_t;
  808. BEGIN
  809. ASSERT(loc # NIL, 20); ASSERT(name # "", 21);
  810. res := ok; f := NIL;
  811. WITH loc: Locator DO
  812. Append(loc.path, name, "", loc.maxLen, fname);
  813. f := ThisFile(fname);
  814. IF f # NIL THEN
  815. IF ~shrd OR (f.state = exclusive) THEN loc.res := Error(sharingErr); RETURN NIL
  816. ELSE loc.res := ok; RETURN f
  817. END
  818. END;
  819. IF shrd THEN s := shared ELSE s := exclusive END;
  820. OpenFile(s, fname, ref, res);
  821. IF ((res = fileNotFoundErr) OR (res = pathNotFoundErr)) & (loc.rootLen > 0) THEN
  822. GetShadowDir(loc, fname);
  823. Append(fname, name, "", loc.maxLen, fname);
  824. f := ThisFile(fname);
  825. IF f # NIL THEN
  826. IF ~shrd OR (f.state = exclusive) THEN loc.res := Error(sharingErr); RETURN NIL
  827. ELSE loc.res := ok; RETURN f
  828. END
  829. END;
  830. OpenFile(s, fname, ref, res)
  831. END;
  832. IF res = ok THEN
  833. NEW(f); f.loc := loc;
  834. f.swapper := -1;
  835. GetType(name, type);
  836. f.InitType(type);
  837. ASSERT(ref # invalid, 107);
  838. f.ref := ref; f.name := fname$; f.state := s; f.t := Kernel.Time();
  839. Stat(f.name, buf, res);
  840. f.len := buf.st_size;
  841. res := LinLibc.fseek(ref, 0, LinLibc.SEEK_SET);
  842. END
  843. END;
  844. loc.res := Error(res);
  845. RETURN f
  846. END Old;
  847. PROCEDURE (d: Directory) Delete* (loc: Files.Locator; name: Files.Name);
  848. VAR res: INTEGER; fname: FullName;
  849. BEGIN
  850. ASSERT(loc # NIL, 20);
  851. WITH loc: Locator DO
  852. Append(loc.path, name, "", loc.maxLen, fname);
  853. Delete(fname, loc.path, res)
  854. ELSE res := invalidNameErr
  855. END;
  856. loc.res := Error(res)
  857. END Delete;
  858. PROCEDURE (d: Directory) Rename* (loc: Files.Locator; old, new: Files.Name; ask: BOOLEAN);
  859. VAR res, i: INTEGER; oldname, newname: FullName; f: File; on, nn, tn: ShortName; buf: LinLibc.stat_t;
  860. BEGIN
  861. ASSERT(loc # NIL, 20);
  862. WITH loc: Locator DO
  863. Append(loc.path, old, "", loc.maxLen, oldname); Append(loc.path, new, "", loc.maxLen, newname);
  864. on := SHORT(oldname$); nn := SHORT(newname$);
  865. Stat(oldname, buf, res);
  866. IF res = ok THEN
  867. f := ThisFile(oldname);
  868. IF (f # NIL) & (f.ref # invalid) THEN res := LinLibc.fclose(f.ref); f.ref := invalid END;
  869. IF Diff(oldname, newname, loc.caseSens) # 0 THEN
  870. CheckDelete(newname, loc.path, ask, res);
  871. IF res = ok THEN
  872. IF LinLibc.rename(on, nn) = 0 THEN
  873. IF f # NIL THEN (* still in use => update file table *)
  874. f.name := newname$
  875. END
  876. ELSE res := LinLibc_errno()
  877. END
  878. END
  879. ELSE (* destination is same file as source *)
  880. tn := on$; i := LEN(tn$) - 1;
  881. REPEAT
  882. tn[i] := SHORT(CHR(ORD(tn[i]) + 1));
  883. MoveFile(on, tn, res);
  884. UNTIL (res # fileExistsErr) & (res # alreadyExistsErr) & (res # 87);
  885. IF res = ok THEN
  886. MoveFile(tn, nn, res)
  887. END
  888. END
  889. ELSE res := fileNotFoundErr
  890. END
  891. ELSE res := invalidNameErr
  892. END;
  893. loc.res := Error(res)
  894. END Rename;
  895. PROCEDURE (d: Directory) SameFile* (loc0: Files.Locator; name0: Files.Name;
  896. loc1: Files.Locator; name1: Files.Name
  897. ): BOOLEAN;
  898. VAR p0, p1: FullName;
  899. BEGIN
  900. ASSERT(loc0 # NIL, 20); ASSERT(loc1 # NIL, 21);
  901. WITH loc0: Locator DO Append(loc0.path, name0, "", loc0.maxLen, p0) END;
  902. WITH loc1: Locator DO Append(loc1.path, name1, "", loc1.maxLen, p1) END;
  903. RETURN Diff(p0, p1, loc0(Locator).caseSens) = 0
  904. END SameFile;
  905. PROCEDURE (d: Directory) FileList* (loc: Files.Locator): Files.FileInfo;
  906. VAR diff, res: INTEGER; first, last, info: Files.FileInfo; s: FullName;
  907. ss, fname: ShortName; dirp: LinLibc.PtrDIR; dp: LinLibc.PtrDirent; buf: LinLibc.stat_t; tm: LinLibc.tm;
  908. isDir: BOOLEAN; attr: SET;
  909. BEGIN
  910. ASSERT(loc # NIL, 20);
  911. first := NIL; last :=NIL;
  912. WITH loc: Locator DO
  913. ss := SHORT(loc.path);
  914. dirp := LinLibc.opendir(ss);
  915. IF dirp # LinLibc.NULL THEN
  916. dp := LinLibc.readdir(dirp);
  917. WHILE dp # NIL DO
  918. IF (dp.d_name # ".") & (dp.d_name # "..") & (LEN(dp.d_name$) < LEN(info.name)) THEN
  919. fname := ss + "/" + dp.d_name;
  920. res := LinLibc.__xstat(3, fname, buf); (* macro expansion of "stat" *)
  921. ModeToAttr(buf.st_mode, attr, isDir);
  922. IF ~isDir THEN
  923. info := first; last := NIL; s := dp.d_name$;
  924. WHILE (info # NIL) & (Diff(info.name, s, loc.caseSens) < 0) DO last := info; info := info.next END;
  925. NEW(info);
  926. info.name := dp.d_name$;
  927. GetType(info.name, info.type);
  928. info.length := buf.st_size;
  929. tm := LinLibc.localtime(buf.st_mtime);
  930. IF tm # NIL THEN
  931. info.modified.year := tm.tm_year + 1900;
  932. info.modified.month := tm.tm_mon + 1;
  933. info.modified.day := tm.tm_mday;
  934. info.modified.hour := tm.tm_hour;
  935. info.modified.minute := tm.tm_min;
  936. info.modified.second := tm.tm_sec
  937. END;
  938. info.attr := attr;
  939. IF last = NIL THEN info.next := first; first := info ELSE info.next := last.next; last.next := info END
  940. END
  941. END;
  942. dp := LinLibc.readdir(dirp)
  943. END;
  944. res := LinLibc.closedir(dirp)
  945. ELSE res := LinLibc_errno()
  946. END;
  947. (* check startup directory *)
  948. IF (loc.rootLen > 0) & ((res = ok) OR (res = fileNotFoundErr) OR (res = pathNotFoundErr)) THEN
  949. GetShadowDir(loc, s);
  950. ss := SHORT(s$);
  951. dirp := LinLibc.opendir(ss);
  952. IF dirp # LinLibc.NULL THEN
  953. dp := LinLibc.readdir(dirp);
  954. WHILE dp # NIL DO
  955. IF (dp.d_name # ".") & (dp.d_name # "..") & (LEN(dp.d_name$) < LEN(info.name)) THEN
  956. fname := ss + "/" + dp.d_name;
  957. res := LinLibc.__xstat(3, fname, buf); (* macro expansion of "stat" *)
  958. ModeToAttr(buf.st_mode, attr, isDir);
  959. IF ~isDir THEN
  960. info := first; last := NIL; s := dp.d_name$;
  961. IF info # NIL THEN diff := Diff(info.name, s, loc.caseSens) END;
  962. WHILE (info # NIL) & (diff < 0) DO
  963. last := info; info := info.next;
  964. IF info # NIL THEN diff := Diff(info.name, s, loc.caseSens) END
  965. END;
  966. IF (info = NIL) OR (diff # 0) THEN
  967. NEW(info);
  968. info.name := dp.d_name$;
  969. GetType(info.name, info.type);
  970. info.length := buf.st_size;
  971. tm := LinLibc.localtime(buf.st_mtime);
  972. IF tm # NIL THEN
  973. info.modified.year := tm.tm_year + 1900;
  974. info.modified.month := tm.tm_mon + 1;
  975. info.modified.day := tm.tm_mday;
  976. info.modified.hour := tm.tm_hour;
  977. info.modified.minute := tm.tm_min;
  978. info.modified.second := tm.tm_sec
  979. END;
  980. info.attr := attr;
  981. IF last = NIL THEN info.next := first; first := info ELSE info.next := last.next; last.next := info END
  982. END
  983. END
  984. END;
  985. dp := LinLibc.readdir(dirp)
  986. END;
  987. res := LinLibc.closedir(dirp)
  988. ELSE res := LinLibc_errno()
  989. END
  990. END;
  991. loc.res := Error(res)
  992. ELSE loc.res := invalidName
  993. END;
  994. RETURN first
  995. END FileList;
  996. PROCEDURE (d: Directory) LocList* (loc: Files.Locator): Files.LocInfo;
  997. VAR diff, res: INTEGER; first, last, info: Files.LocInfo; s: FullName; isDir: BOOLEAN; attr: SET;
  998. ss, fname: ShortName; dirp: LinLibc.PtrDIR; dp: LinLibc.PtrDirent; buf: LinLibc.stat_t;
  999. BEGIN
  1000. ASSERT(loc # NIL, 20);
  1001. first := NIL; last :=NIL;
  1002. WITH loc: Locator DO
  1003. ss := SHORT(loc.path);
  1004. dirp := LinLibc.opendir(ss);
  1005. IF dirp # LinLibc.NULL THEN
  1006. dp := LinLibc.readdir(dirp);
  1007. WHILE dp # NIL DO
  1008. IF (dp.d_name # ".") & (dp.d_name # "..") & (LEN(dp.d_name$) < LEN(info.name)) THEN
  1009. fname := ss + "/" + dp.d_name;
  1010. res := LinLibc.__xstat(3, fname, buf); (* macro expansion of "stat" *)
  1011. ModeToAttr(buf.st_mode, attr, isDir);
  1012. IF isDir THEN
  1013. info := first; last := NIL; s := dp.d_name$;
  1014. WHILE (info # NIL) & (Diff(info.name, s, loc.caseSens) < 0) DO last := info; info := info.next END;
  1015. NEW(info);
  1016. info.name := dp.d_name$;
  1017. info.attr := attr;
  1018. IF last = NIL THEN info.next := first; first := info ELSE info.next := last.next; last.next := info END
  1019. END
  1020. END;
  1021. dp := LinLibc.readdir(dirp)
  1022. END;
  1023. res := LinLibc.closedir(dirp)
  1024. ELSE res := LinLibc_errno()
  1025. END;
  1026. (* check startup directory *)
  1027. IF (loc.rootLen > 0) & ((res = ok) OR (res = fileNotFoundErr) OR (res = pathNotFoundErr)) THEN
  1028. GetShadowDir(loc, s);
  1029. ss := SHORT(s$);
  1030. dirp := LinLibc.opendir(ss);
  1031. IF dirp # LinLibc.NULL THEN
  1032. dp := LinLibc.readdir(dirp);
  1033. WHILE dp # NIL DO
  1034. IF (dp.d_name # ".") & (dp.d_name # "..") & (LEN(dp.d_name$) < LEN(info.name)) THEN
  1035. fname := ss + "/" + dp.d_name;
  1036. res := LinLibc.__xstat(3, fname, buf); (* macro expansion of "stat" *)
  1037. ModeToAttr(buf.st_mode, attr, isDir);
  1038. IF isDir THEN
  1039. info := first; last := NIL; s := dp.d_name$;
  1040. IF info # NIL THEN diff := Diff(info.name, s, loc.caseSens) END;
  1041. WHILE (info # NIL) & (diff < 0) DO
  1042. last := info; info := info.next;
  1043. IF info # NIL THEN diff := Diff(info.name, s, loc.caseSens) END
  1044. END;
  1045. IF (info = NIL) OR (diff # 0) THEN
  1046. NEW(info);
  1047. info.name := dp.d_name$;
  1048. info.attr := attr;
  1049. IF last = NIL THEN info.next := first; first := info ELSE info.next := last.next; last.next := info END
  1050. END
  1051. END
  1052. END;
  1053. dp := LinLibc.readdir(dirp)
  1054. END;
  1055. res := LinLibc.closedir(dirp)
  1056. ELSE res := LinLibc_errno()
  1057. END
  1058. END;
  1059. loc.res := Error(res)
  1060. ELSE loc.res := invalidName
  1061. END;
  1062. RETURN first
  1063. END LocList;
  1064. PROCEDURE (d: Directory) GetFileName (name: Files.Name; type: Files.Type; OUT filename: Files.Name);
  1065. BEGIN
  1066. Append("", name, type, LEN(filename), filename)
  1067. END GetFileName;
  1068. (** Miscellaneous **)
  1069. PROCEDURE (VAR id: Counter) Identified (): BOOLEAN;
  1070. VAR f: File;
  1071. BEGIN
  1072. f := id.obj(File);
  1073. IF f.state # closed THEN INC(id.count) END;
  1074. RETURN FALSE
  1075. END Identified;
  1076. PROCEDURE NofFiles* (): INTEGER;
  1077. VAR p: ANYPTR; cnt: Counter;
  1078. BEGIN
  1079. cnt.typ := SYSTEM.TYP(File);
  1080. cnt.count := 0; p := Kernel.ThisFinObj(cnt);
  1081. RETURN cnt.count
  1082. END NofFiles;
  1083. PROCEDURE GetModDate* (f: Files.File; VAR year, month, day, hour, minute, second: INTEGER);
  1084. VAR buf: LinLibc.stat_t; tm: LinLibc.tm;
  1085. BEGIN
  1086. ASSERT(f IS File, 20);
  1087. Stat(f(File).name, buf, res);
  1088. IF res = ok THEN
  1089. tm := LinLibc.localtime(buf.st_mtime);
  1090. IF tm # NIL THEN
  1091. year := tm.tm_year + 1900; month := tm.tm_mon + 1; day := tm.tm_mday;
  1092. hour := tm.tm_hour; minute := tm.tm_min; second := tm.tm_sec
  1093. ELSE
  1094. res := -1
  1095. END
  1096. END;
  1097. IF res # ok THEN year := 0; month := 0; day := 0; hour := 0; minute := 0; second := 0 END
  1098. END GetModDate;
  1099. PROCEDURE SetRootDir* (path: ARRAY OF CHAR);
  1100. VAR i: INTEGER;
  1101. BEGIN
  1102. dir.startup := NewLocator(path);
  1103. dir.startup.rootLen := 0; i := 0;
  1104. WHILE startupDir[i] # 0X DO INC(i) END;
  1105. startupLen := i
  1106. END SetRootDir;
  1107. PROCEDURE GetName (VAR p: ARRAY OF CHAR; VAR i: INTEGER; VAR name, opt: FullName);
  1108. VAR ch, tch: CHAR; j: INTEGER;
  1109. BEGIN
  1110. j := 0; ch := p[i]; tch := " ";
  1111. WHILE ch = " " DO INC(i); ch := p[i] END;
  1112. IF (ch = "'") OR (ch = '"') THEN tch := ch; INC(i); ch := p[i] END;
  1113. WHILE (ch >= " ") & (ch # tch) DO
  1114. name[j] := ch;
  1115. IF (ch >= "a") & (ch <= "z") OR (ch >= "à") & (ch <= "ö") OR (ch >= "ø") & (ch <= "þ") THEN ch := CAP(ch)
  1116. ELSIF ch = "-" THEN ch := "/"
  1117. END;
  1118. opt[j] := ch; INC(j); INC(i); ch := p[i]
  1119. END;
  1120. IF ch > " " THEN INC(i); ch := p[i] END;
  1121. WHILE (ch # 0X) & (ch <= " ") DO INC(i); ch := p[i] END;
  1122. name[j] := 0X; opt[j] := 0X
  1123. END GetName;
  1124. PROCEDURE Init;
  1125. VAR res, i, slp: INTEGER; path, opt: FullName; attr: SET; p: LinLibc.PtrSTR; str: ARRAY 256 OF CHAR;
  1126. buf: LinLibc.stat_t; isDir: BOOLEAN;
  1127. BEGIN
  1128. (*
  1129. TODO:
  1130. Instead of using getcwd below to find the local path it would be better to use Kernel.bootinfo.argv[0].
  1131. But this only works if the PATH variable of the shell is not set to hold the BlackBox directory. In that
  1132. case all directories in the PATH variable has to be searched for the blackbox executable:
  1133. if (argv[0][0] == '/')
  1134. s = argv[0]
  1135. else {
  1136. str = getenv( "PATH" ); len = strlen( str );
  1137. for ( i = 0, s = 0; i < len; i++ )
  1138. if ( str[i] == ':' ) {
  1139. str[i] = '\0';
  1140. if ( checkpath( str + s, argv[0] ) ) break;
  1141. else s = i + 1;
  1142. }
  1143. }
  1144. *)
  1145. wildcard := "*"; NEW(dir);
  1146. str := Kernel.cmdLine$;
  1147. i := 0; slp := -1;
  1148. WHILE (str[i] # " ") & (str[i] # 0X) DO
  1149. startupDir[i] := str[i];
  1150. IF str[i] = "/" THEN slp := i END;
  1151. INC(i)
  1152. END;
  1153. startupDir[i] := 0X;
  1154. IF slp < 0 THEN
  1155. appName := startupDir;
  1156. p := NIL;
  1157. p := LinLibc.getcwd(p, 0);
  1158. startupDir := p$;
  1159. LinLibc.free(SYSTEM.VAL(LinLibc.PtrVoid, p));
  1160. i := 0;
  1161. WHILE startupDir[i] # 0X DO INC(i) END;
  1162. startupLen := i;
  1163. ELSE
  1164. i := slp + 1;
  1165. WHILE startupDir[i] # 0X DO appName[i - slp - 1] := startupDir[i]; INC(i) END;
  1166. startupDir[slp] := 0X;
  1167. startupLen := slp;
  1168. END;
  1169. dir.startup := NewLocator(startupDir);
  1170. dir.startup.rootLen := 0;
  1171. (*
  1172. p := NIL;
  1173. p := LinLibc.getcwd(p, 0);
  1174. startupDir := p$; LinLibc.free(SYSTEM.VAL(LinLibc.PtrVoid, p));
  1175. dir.startup := NewLocator(startupDir);
  1176. dir.startup.rootLen := 0; i := 0;
  1177. WHILE startupDir[i] # 0X DO INC(i) END;
  1178. startupLen := i;
  1179. str := Kernel.cmdLine$;
  1180. *)
  1181. (*
  1182. i := 0;
  1183. WHILE (str[i] # " ") & (str[i] # 0X) DO appName[i] := str[i]; INC(i) END;
  1184. appName[i] := 0X;
  1185. *)
  1186. i := 0; res := 1;
  1187. REPEAT
  1188. GetName(str, i, path, opt);
  1189. IF opt = "/USE" THEN
  1190. GetName(str, i, path, opt);
  1191. Stat(path, buf, res);
  1192. IF res =ok THEN
  1193. ModeToAttr(buf.st_mode, attr, isDir);
  1194. IF isDir THEN res := ok ELSE res := invalidName END
  1195. END
  1196. END
  1197. UNTIL (res = 0) OR (str[i] < " ");
  1198. IF serverVersion & (res = 0) THEN
  1199. i := 0; WHILE path[i] # 0X DO INC(i) END;
  1200. IF (path[i-1] = "/") OR (path[i-1] = "\") THEN DEC(i); path[i] := 0X END;
  1201. dir.startup := NewLocator(path);
  1202. dir.startup.rootLen := SHORT(i)
  1203. END;
  1204. dir.temp := NewLocator(LinLibc.P_tmpdir);
  1205. Files.SetDir(dir)
  1206. END Init;
  1207. BEGIN
  1208. Init
  1209. END HostFiles.