Files.txt 43 KB

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