Files.txt 43 KB

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