FATFiles.Mod 62 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901
  1. (* Aos, Copyright 2001, Pieter Muller, ETH Zurich *)
  2. MODULE FATFiles; (** AUTHOR "be"; PURPOSE "FAT file systems" *)
  3. IMPORT SYSTEM, Kernel, Modules, Strings, UTF8Strings, Files, FATVolumes, Clock, KernelLog;
  4. CONST
  5. moduleName = "FATFiles: ";
  6. Ok* = FATVolumes.Ok;
  7. NotAssigned = FATVolumes.EOC; (* must be -1 *)
  8. PathDelimiter = Files.PathDelimiter;
  9. EOC = FATVolumes.EOC;
  10. FREE = FATVolumes.FREE;
  11. ErrReadOnly* = FATVolumes.ErrReadOnly;
  12. ErrInvalidParams* = FATVolumes.ErrInvalidParams;
  13. ErrIOError* = FATVolumes.ErrIOError;
  14. ErrFileReadOnly* = 2921;
  15. ErrParentNotFound* = 2922;
  16. ErrInvalidFilename* = 2923;
  17. ErrTooManySimilarFiles* = 2924;
  18. ErrRootDirFull* = 2925;
  19. ErrFileNotFound* = 2926;
  20. ErrFileExists* = 2927;
  21. ErrHasOpenFiles* = 2928;
  22. ErrNoRelativePaths* = 2929;
  23. ErrDirectoryProtection* = 2930;
  24. ErrDirectoryNotEmpty* = 2931;
  25. ErrNotADirectory* = 2932;
  26. ErrDirectoryOpen* = 2933;
  27. MaxFilenameLen* = 3*255 + 1; (** max. 255 characters (UTF8) plus 0X *)
  28. faReadOnly* = 0;
  29. faHidden* = 1;
  30. faSystem* = 2;
  31. faVolumeID* = 3;
  32. faDirectory* = 4;
  33. faArchive* = 5;
  34. faLongName = 15; (* = { faReadOnly, faHidden, faSystem, faVolumeID } *)
  35. faValidMask = {faReadOnly, faHidden, faSystem, faArchive}; (* attributes that can be set by the user *)
  36. WriteProtected = {faReadOnly, faSystem}; (* files containing one of these flags are automatically write-protected *)
  37. deFree = 0E5X;
  38. deLast = 0X;
  39. TYPE
  40. Address = Files.Address;
  41. Filename* = ARRAY MaxFilenameLen OF CHAR;
  42. Shortname = ARRAY 12 OF CHAR;
  43. Parameter* = POINTER TO RECORD END;
  44. EnumParam = POINTER TO RECORD(Parameter)
  45. flags: SET;
  46. mask, path: Filename;
  47. enum: Files.Enumerator
  48. END;
  49. CountFiles = POINTER TO RECORD(Parameter)
  50. count: LONGINT;
  51. END;
  52. SearchByName = OBJECT
  53. VAR directory: Address; name: Filename; found: File;
  54. PROCEDURE &Init*(Directory: Address; Name: Filename);
  55. BEGIN
  56. directory := Directory; UTF8Strings.UpperCase(Name, name)
  57. END Init;
  58. PROCEDURE EnumFile(f: ANY; VAR cont: BOOLEAN);
  59. VAR filename: Filename;
  60. BEGIN
  61. UTF8Strings.UpperCase(f(File).long, filename);
  62. IF (directory = f(File).parent) & (name = filename) THEN found := f(File) END;
  63. cont := (found = NIL)
  64. END EnumFile;
  65. END SearchByName;
  66. SearchByCluster = OBJECT
  67. VAR cluster: Address; found: File;
  68. PROCEDURE &Init*(Cluster: Address);
  69. BEGIN cluster := Cluster
  70. END Init;
  71. PROCEDURE EnumFile(f: ANY; VAR cont: BOOLEAN);
  72. BEGIN
  73. IF (cluster = f(File).cluster) THEN found := f(File) END;
  74. cont := (found = NIL)
  75. END EnumFile;
  76. END SearchByCluster;
  77. FilePurger = OBJECT
  78. VAR count: LONGINT;
  79. PROCEDURE EnumFile(f: ANY; VAR cont: BOOLEAN);
  80. VAR res: WORD;
  81. BEGIN ASSERT(~f(File).registered);
  82. KernelLog.Enter;
  83. KernelLog.String(moduleName); KernelLog.String("purging anonymous file '"); KernelLog.String(f(File).long); KernelLog.String("'...");
  84. KernelLog.Exit;
  85. f(File).DeleteClusterChain(res); (* ignore res *)
  86. INC(count); cont := TRUE
  87. END EnumFile;
  88. END FilePurger;
  89. FileUpdater = OBJECT
  90. PROCEDURE EnumFile(f: ANY; VAR cont: BOOLEAN);
  91. BEGIN f(File).Update; cont := TRUE
  92. END EnumFile;
  93. END FileUpdater;
  94. FileEnumerator = OBJECT
  95. VAR
  96. count: LONGINT;
  97. directory: Address;
  98. PROCEDURE &Init*(dir: Address);
  99. BEGIN directory := dir; count := 0
  100. END Init;
  101. PROCEDURE EnumFile(f: ANY; VAR cont: BOOLEAN);
  102. BEGIN IF (f(File).parent = directory) OR (directory = NotAssigned) THEN INC(count) END; cont := TRUE
  103. END EnumFile;
  104. END FileEnumerator;
  105. FileSystem* = OBJECT(Files.FileSystem)
  106. VAR
  107. rootDir-: Directory;
  108. openFiles, anonymousFiles: Kernel.FinalizedCollection; (* contains open files with length 0 *)
  109. fileKey: LONGINT;
  110. PROCEDURE &Init*;
  111. BEGIN fileKey := -1; NEW(openFiles); NEW(anonymousFiles)
  112. END Init;
  113. PROCEDURE Initialize;
  114. VAR b: BOOLEAN;
  115. BEGIN {EXCLUSIVE}
  116. ASSERT(vol # NIL); rootDir := NIL;
  117. b := SetRootDirectoryX("") (* ignore result *)
  118. END Initialize;
  119. (* Finalize the file system. *)
  120. PROCEDURE Finalize*;
  121. VAR purge: FilePurger; update: FileUpdater;
  122. BEGIN {EXCLUSIVE}
  123. NEW(purge); purge.count := 0;
  124. anonymousFiles.Enumerate(purge.EnumFile);
  125. IF (purge.count # 0) THEN
  126. KernelLog.Enter;
  127. KernelLog.String(moduleName); KernelLog.Int(purge.count, 0); KernelLog.String(" anonymous files purged. ");
  128. KernelLog.Exit
  129. END;
  130. NEW(update);
  131. openFiles.Enumerate(update.EnumFile);
  132. vol.Finalize;
  133. Finalize^; (* see note in Files *)
  134. (* do not release exclusive lock ! *)
  135. END Finalize;
  136. PROCEDURE GetNextFileKey(): LONGINT;
  137. BEGIN
  138. DEC(fileKey);
  139. RETURN fileKey
  140. END GetNextFileKey;
  141. PROCEDURE SetRootDirectory*(name: ARRAY OF CHAR): BOOLEAN;
  142. BEGIN {EXCLUSIVE} RETURN SetRootDirectoryX(name)
  143. END SetRootDirectory;
  144. PROCEDURE SetRootDirectoryX(name: ARRAY OF CHAR): BOOLEAN;
  145. VAR dir1216: RootDirectory1216; dir32: RootDirectory32; f: File;
  146. BEGIN
  147. IF (name = "") THEN (* default root *)
  148. IF (vol IS FATVolumes.FAT1216Volume) THEN
  149. NEW(dir1216, SELF); dir1216.cluster := 0;
  150. rootDir := dir1216
  151. ELSIF (vol IS FATVolumes.FAT32Volume) THEN
  152. NEW(dir32, SELF); dir32.cluster := vol(FATVolumes.FAT32Volume).rootCluster;
  153. rootDir := dir32; COPY(Files.PathDelimiter, rootDir.long)
  154. END;
  155. rootDir.long := ""; rootDir.parent := NotAssigned; rootDir.key := -1
  156. ELSE
  157. f := OldX(name);
  158. IF (f # NIL) & (f IS Directory) THEN rootDir := f(Directory)
  159. ELSE RETURN FALSE
  160. END
  161. END;
  162. rootDir.long := ""; rootDir.parent := NotAssigned; rootDir.key := -1;
  163. RETURN TRUE
  164. END SetRootDirectoryX;
  165. (* Create a new file with the specified name. End users use Files.New instead. *)
  166. PROCEDURE New0*(name: ARRAY OF CHAR): Files.File;
  167. VAR path, filename: Filename; dir: Directory; f: File;
  168. BEGIN {EXCLUSIVE}
  169. IF UTF8Strings.Valid(name) THEN
  170. Files.SplitPath(name, path, filename);
  171. IF ((filename = "") OR ValidateName(filename)) THEN
  172. IF (path # "") THEN
  173. UTF8Strings.UpperCase(path, path);
  174. dir := FindDirectory(path)
  175. ELSE dir := rootDir
  176. END;
  177. IF (dir # NIL) THEN
  178. NEW(f, SELF);
  179. COPY(filename, f.long); f.attr := {}; f.NTres := 0X;
  180. f.cluster := EOC; f.parent := dir.cluster; f.size := 0;
  181. Clock.Get(f.time, f.date);
  182. f.writeTime := f.time; f.writeDate := f.date; f.accessDate := f.date;
  183. f.modH := TRUE; f.modName := TRUE; f.registered := FALSE;
  184. f.entry.len := NotAssigned; f.entry.ofs := NotAssigned;
  185. f.key := 0;
  186. anonymousFiles.Add(f, PurgeFile); openFiles.Add(f, NIL)
  187. END
  188. END
  189. END;
  190. RETURN f
  191. END New0;
  192. (* Open an existing file. The same file descriptor is returned if a file is opened multiple times. End users use Files.Old instead. *)
  193. PROCEDURE Old0*(name: ARRAY OF CHAR): Files.File;
  194. BEGIN {EXCLUSIVE} RETURN OldX(name)
  195. END Old0;
  196. PROCEDURE OldX(name: ARRAY OF CHAR): File;
  197. VAR path, filename: Filename; dir: Directory; f: File;
  198. BEGIN
  199. IF UTF8Strings.Valid(name) THEN
  200. UTF8Strings.UpperCase(name, name);
  201. IF (name = PathDelimiter) THEN RETURN rootDir
  202. ELSE
  203. Files.SplitPath(name, path, filename);
  204. IF ValidateName(filename) THEN
  205. IF (path # "") THEN dir := FindDirectory(path)
  206. ELSE dir := rootDir
  207. END;
  208. IF (dir # NIL) THEN
  209. f := dir.Find(filename);
  210. IF (f # NIL) THEN
  211. openFiles.Add(f, NIL);
  212. IF (f.cluster = 0) THEN
  213. (* we don't need to check if this file is open since Files.Old already checks this *)
  214. f.key := GetNextFileKey();
  215. f.cluster := EOC
  216. ELSE
  217. f.key := f.cluster
  218. END
  219. END
  220. END
  221. END
  222. END
  223. END;
  224. RETURN f
  225. END OldX;
  226. (** Delete a file. res = 0 indicates success. End users use Files.Delete instead. *)
  227. PROCEDURE Delete0*(name: ARRAY OF CHAR; VAR key: LONGINT; VAR res: WORD);
  228. BEGIN {EXCLUSIVE} Delete0X(name, key, res)
  229. END Delete0;
  230. PROCEDURE Delete0X(name: ARRAY OF CHAR; VAR key: LONGINT; VAR res: WORD);
  231. VAR path, filename: Filename; dir: Directory; f: File; s: SearchByName; dcc: BOOLEAN;
  232. BEGIN
  233. res := ErrInvalidFilename; key := 0;
  234. IF UTF8Strings.Valid(name) THEN
  235. UTF8Strings.UpperCase(name, name);
  236. Files.SplitPath(name, path, filename);
  237. IF ValidateName(filename) THEN
  238. res := ErrFileNotFound;
  239. IF (path # "") THEN dir := FindDirectory(path)
  240. ELSE dir := rootDir
  241. END;
  242. IF (dir # NIL) THEN
  243. res := ErrFileNotFound;
  244. NEW(s, dir.cluster, filename); openFiles.Enumerate(s.EnumFile);
  245. IF (s.found # NIL) THEN f := s.found; dcc := FALSE
  246. ELSE f := dir.Find(filename); dcc := TRUE
  247. END;
  248. IF (f # NIL) THEN
  249. IF (f IS Directory) & (f.attr * WriteProtected # {}) THEN res := ErrDirectoryProtection
  250. ELSE
  251. IF (f.attr * WriteProtected = {}) THEN
  252. key := f.key;
  253. IF dcc THEN (* file is not open, remove cluster chain *)
  254. f.DeleteClusterChain(res); (* ignore res *)
  255. anonymousFiles.Remove(f)
  256. ELSE (* file is open and now anonymous *)
  257. anonymousFiles.Add(f, PurgeFile)
  258. END;
  259. dir.RemoveFileHeader(f);
  260. res := Ok
  261. ELSE res := ErrFileReadOnly
  262. END
  263. END
  264. END
  265. END
  266. END
  267. END
  268. END Delete0X;
  269. (* Rename a file. res = 0 indicates success. End users use Files.Rename instead. *)
  270. PROCEDURE Rename0*(old, new: ARRAY OF CHAR; f: Files.File; VAR res: WORD);
  271. VAR oldpath, oldname, newpath, newname: Filename; r: File; dir: Directory; s: SearchByName;
  272. BEGIN {EXCLUSIVE}
  273. res := ErrInvalidFilename;
  274. IF UTF8Strings.Valid(old) & UTF8Strings.Valid(new) THEN
  275. Files.SplitPath(old, oldpath, oldname);
  276. Files.SplitPath(new, newpath, newname);
  277. IF ((oldpath = newpath) OR (newpath = "")) & ValidateName(newname) THEN
  278. IF (f = NIL) THEN f := OldX(old)
  279. ELSIF ~(f IS File) THEN HALT(ErrInvalidParams)
  280. END;
  281. IF (f # NIL) THEN
  282. r := OldX(new);
  283. IF (r # NIL) THEN (* replace existing file *)
  284. IF (r IS Directory) THEN res := ErrDirectoryProtection; RETURN
  285. ELSE
  286. NEW(s, r.parent, r.long); openFiles.Enumerate(s.EnumFile);
  287. IF (s.found = NIL) THEN r.DeleteClusterChain(res) END; (* file not open, remove cluster chain (ignore res) *)
  288. IF r.registered THEN (* remove file header *)
  289. dir := GetDirectoryX(r.parent);
  290. dir.RemoveFileHeader(r)
  291. END
  292. END
  293. END;
  294. COPY(newname, f(File).long);
  295. f(File).modH := TRUE; f(File).modName := TRUE;
  296. f.Update;
  297. res := Ok
  298. ELSE res := ErrFileNotFound
  299. END
  300. END
  301. END
  302. END Rename0;
  303. (* Enumerate canonical file names. mask may contain * wildcards. For internal use only. End users use Enumerator instead. *)
  304. PROCEDURE Enumerate(file: File; par: Parameter): BOOLEAN;
  305. VAR name: Filename; len: LONGINT; flags: SET;
  306. BEGIN
  307. WITH par: EnumParam DO
  308. UTF8Strings.UpperCase(file.long, name);
  309. IF (par.mask = "") OR Strings.Match(par.mask, name) THEN
  310. Strings.Concat(par.path, file.long, name);
  311. IF (faDirectory IN file.attr) THEN len := 0; flags := { Files.Directory }
  312. ELSE len := file.Length(); flags := {}
  313. END;
  314. par.enum.PutEntry(name, flags, file.writeTime, file.writeDate, len)
  315. END;
  316. RETURN TRUE
  317. END
  318. END Enumerate;
  319. PROCEDURE Enumerate0*(mask: ARRAY OF CHAR; flags: SET; enum: Files.Enumerator);
  320. VAR d: Directory; path: Filename; par: EnumParam;
  321. BEGIN {EXCLUSIVE}
  322. IF UTF8Strings.Valid(mask) THEN
  323. NEW(par); par.flags := flags; par.enum := enum; par.mask := "";
  324. UTF8Strings.UpperCase(mask, mask);
  325. d := FindDirectory(mask);
  326. IF (d = NIL) THEN
  327. Files.SplitPath(mask, path, par.mask);
  328. IF (path # "") THEN d := FindDirectory(path)
  329. ELSE d := rootDir
  330. END
  331. END;
  332. IF (d # NIL) THEN
  333. d.GetFullName(par.path, TRUE);
  334. d.Enumerate(Enumerate, par)
  335. END
  336. END
  337. END Enumerate0;
  338. (* Return the unique non-zero key of the named file, if it exists. *)
  339. PROCEDURE FileKey*(name: ARRAY OF CHAR): LONGINT;
  340. VAR s: SearchByName; path, filename: Filename; dir: Directory; f: File; key: LONGINT;
  341. BEGIN {EXCLUSIVE}
  342. IF UTF8Strings.Valid(name) THEN
  343. UTF8Strings.UpperCase(name, name);
  344. Files.SplitPath(name, path, filename);
  345. IF ValidateName(filename) THEN
  346. IF (path # "") THEN dir := FindDirectory(path)
  347. ELSE dir := rootDir
  348. END;
  349. IF (dir # NIL) THEN
  350. f := dir.Find(filename);
  351. IF (f # NIL) THEN
  352. IF (f.cluster = 0) THEN
  353. NEW(s, dir.cluster, filename); openFiles.Enumerate(s.EnumFile);
  354. IF (s.found # NIL) THEN key := s.found.key END
  355. ELSE key := f.cluster
  356. END
  357. END
  358. END
  359. END
  360. END;
  361. RETURN key
  362. END FileKey;
  363. PROCEDURE CreateDirectory0*(path: ARRAY OF CHAR; VAR res: WORD);
  364. VAR f: File; d: Directory; i,j: LONGINT; name: Filename; lookup: BOOLEAN; s: SearchByName;
  365. BEGIN {EXCLUSIVE}
  366. IF (Files.ReadOnly IN vol.flags) THEN res := ErrReadOnly; RETURN END;
  367. res := ErrFileExists;
  368. d := rootDir; i := 0; lookup := TRUE;
  369. IF (path[i] = PathDelimiter) THEN INC(i) END;
  370. WHILE (path[i] # 0X) & (d # NIL) DO
  371. j := 0; WHILE (path[i] # 0X) & (path[i] # PathDelimiter) DO name[j] := path[i]; INC(i); INC(j) END;
  372. name[j] := 0X;
  373. IF (path[i] = PathDelimiter) THEN INC(i) END;
  374. IF (name # "") & (name # ".") & (name # "..") THEN
  375. IF lookup THEN
  376. NEW(s, d.cluster, name); openFiles.Enumerate(s.EnumFile);
  377. IF (s.found # NIL) THEN f := s.found;
  378. ELSE f := d.Find(name)
  379. END;
  380. ELSE f := NIL
  381. END;
  382. IF (f # NIL) & f.registered THEN
  383. IF (f IS Directory) THEN d := f(Directory)
  384. ELSE res := ErrFileExists; d := NIL
  385. END
  386. ELSE
  387. lookup := FALSE;
  388. IF (f # NIL) THEN (* anonymous directory *)
  389. f.modH := TRUE; f.modName := TRUE;
  390. f.Register0(res)
  391. ELSE
  392. d := d.NewSubdirectory(name, res)
  393. END
  394. END
  395. ELSE
  396. IF (name = "") THEN res := ErrInvalidFilename
  397. ELSE res := ErrNoRelativePaths
  398. END;
  399. d := NIL
  400. END
  401. END
  402. END CreateDirectory0;
  403. PROCEDURE RmDirCallback(f: File; par: Parameter): BOOLEAN;
  404. BEGIN INC(par(CountFiles).count); RETURN TRUE
  405. END RmDirCallback;
  406. PROCEDURE RemoveDirectory0*(path: ARRAY OF CHAR; force: BOOLEAN; VAR key: LONGINT; VAR res: WORD);
  407. VAR f: File; par: CountFiles; s: SearchByName; parent: Directory;
  408. BEGIN {EXCLUSIVE}
  409. IF (Files.ReadOnly IN vol.flags) THEN res := ErrReadOnly; RETURN END;
  410. res := Ok;
  411. f := OldX(path);
  412. IF (f # NIL) THEN
  413. IF (f IS Directory) THEN
  414. NEW(s, f.parent, f.long); openFiles.Enumerate(s.EnumFile);
  415. IF (s.found = NIL) OR (s.found = f) THEN
  416. NEW(par); par.count := 0;
  417. f(Directory).Enumerate(RmDirCallback, par);
  418. IF (par.count > 0) THEN
  419. IF force THEN f(Directory).DeleteContents(res)
  420. ELSE res := ErrDirectoryNotEmpty
  421. END
  422. END;
  423. IF (res = Ok) THEN
  424. key := f.key;
  425. f.DeleteClusterChain(res);
  426. parent := GetDirectoryX(f.parent);
  427. parent.RemoveFileHeader(f);
  428. openFiles.Remove(f);
  429. anonymousFiles.Remove(f)
  430. END
  431. ELSE res := ErrDirectoryOpen
  432. END
  433. ELSE res := ErrNotADirectory
  434. END
  435. ELSE res := ErrFileNotFound
  436. END
  437. END RemoveDirectory0;
  438. PROCEDURE QuickFormat*(volLabel: ARRAY OF CHAR; VAR res: WORD);
  439. VAR f: File; label: ARRAY 11 OF CHAR; i: LONGINT;
  440. clean: FileEnumerator; c: CHAR; dummy: BOOLEAN;
  441. BEGIN {EXCLUSIVE}
  442. IF (Files.ReadOnly IN vol.flags) THEN res := ErrReadOnly; RETURN END;
  443. (* check and copy volume label *)
  444. res := Ok;
  445. FOR i := 0 TO 10 DO label[i] := " " END;
  446. i := 0;
  447. WHILE (i < 11) & (volLabel[i] # 0X) DO
  448. c := volLabel[i];
  449. IF ("a" <= c) & (c <= "z") THEN c := CAP(c) END;
  450. IF ValidShortChar(c) THEN label[i] := c
  451. ELSE res := ErrInvalidParams; i := 11
  452. END;
  453. INC(i)
  454. END;
  455. IF (res = Ok) THEN
  456. NEW(clean, NotAssigned);
  457. openFiles.Enumerate(clean.EnumFile);
  458. IF (clean.count = 0) THEN anonymousFiles.Enumerate(clean.EnumFile) END;
  459. IF (clean.count = 0) THEN
  460. vol(FATVolumes.Volume).QuickFormat;
  461. (* init root *)
  462. dummy := SetRootDirectoryX("");
  463. (* write volume label *)
  464. NEW(f, SELF);
  465. COPY(label, vol.name);
  466. COPY(label, f.long);
  467. f.cluster := NotAssigned; f.attr := {faVolumeID};
  468. Clock.Get(f.time, f.date);
  469. f.modH := TRUE; f.modName := TRUE;
  470. rootDir.firstFreePos := 0;
  471. rootDir.WriteFileHeader(f);
  472. res := Ok
  473. ELSE
  474. res := ErrHasOpenFiles
  475. END
  476. END
  477. END QuickFormat;
  478. PROCEDURE FindDirectory(path: ARRAY OF CHAR): Directory;
  479. VAR dir: Directory; f: File; s: SearchByName;
  480. pos, k: LONGINT; p: Filename;
  481. BEGIN
  482. dir := rootDir; pos := 0;
  483. IF (path[0] = PathDelimiter) THEN INC(pos) END;
  484. WHILE (path[pos] # 0X) & (dir # NIL) DO
  485. k := 0;
  486. WHILE (path[pos] # PathDelimiter) & (path[pos] # 0X) DO
  487. p[k] := path[pos];
  488. INC(k); INC(pos)
  489. END;
  490. p[k] := 0X;
  491. IF (path[pos] = PathDelimiter) THEN INC(pos) END;
  492. IF (p = ".") OR (p = "..") THEN (* error, relative paths not supported *)
  493. RETURN NIL
  494. ELSE (* down *)
  495. f := dir.Find(p);
  496. IF (f # NIL) & (f IS Directory) THEN
  497. NEW(s, f.parent, p); openFiles.Enumerate(s.EnumFile);
  498. IF (s.found # NIL) THEN dir := s.found(Directory)
  499. ELSE dir := f(Directory)
  500. END
  501. ELSE dir := NIL
  502. END
  503. END
  504. END;
  505. RETURN dir
  506. END FindDirectory;
  507. PROCEDURE GetDirectory(cluster: Address): Directory;
  508. BEGIN {EXCLUSIVE}
  509. RETURN GetDirectoryX(cluster)
  510. END GetDirectory;
  511. PROCEDURE GetDirectoryX(cluster: Address): Directory;
  512. VAR dir: Directory; r: Files.Rider; dotdot: ARRAY 3 OF CHAR; s: SearchByCluster;
  513. BEGIN
  514. IF (cluster = rootDir.cluster) OR (cluster = 0) THEN dir := rootDir
  515. ELSE
  516. (* already open ? *)
  517. NEW(s, cluster); openFiles.Enumerate(s.EnumFile);
  518. IF (s.found = NIL) THEN
  519. NEW(dir, SELF); dir.attr := {faDirectory, faReadOnly};
  520. dir.cluster := cluster;
  521. (* make sure directory is valid *)
  522. dir.Set(r, 32); dir.ReadBytes(r, dotdot, 0, 3);
  523. IF (dotdot[0] # ".") OR (dotdot[1] # ".") OR (dotdot[2] # " ") THEN dir := NIL
  524. ELSE openFiles.Add(dir, NIL)
  525. END
  526. ELSE
  527. dir := s.found(Directory)
  528. END
  529. END;
  530. RETURN dir
  531. END GetDirectoryX;
  532. END FileSystem;
  533. TYPE
  534. DirEntry = RECORD
  535. ofs, len: LONGINT;
  536. END;
  537. Buffer = POINTER TO RECORD
  538. pos: LONGINT; eoc: BOOLEAN;
  539. cluster: Address;
  540. data: POINTER TO ARRAY OF CHAR;
  541. END;
  542. File* = OBJECT(Files.File)
  543. (* Files.Rider:
  544. apos: logical cluster number 0...(#clusters-1) or 'NotAssigned'
  545. bpos: position within cluster
  546. *)
  547. VAR
  548. short: Shortname;
  549. long-: Filename; (** file name *)
  550. attr: SET;
  551. NTres: CHAR;
  552. cluster, parent: Address; (* 'parent': cluster of directory containing file *)
  553. size: LONGINT;
  554. time, date, writeTime-, writeDate-, accessDate-: LONGINT;
  555. modH, modName: BOOLEAN; (* TRUE if the directory entry needs to be written back to disk, modName is TRUE if the name has changed *)
  556. writeEOC: BOOLEAN;
  557. eocCluster: LONGINT;
  558. entry: DirEntry; (* offset & length of directory entry *)
  559. registered-: BOOLEAN; (* TRUE if the file is registered in a directory. Possible race ! *)
  560. clusterSize: LONGINT;
  561. buffer: Buffer;
  562. PROCEDURE &Init*(fs: Files.FileSystem);
  563. BEGIN
  564. SELF.fs := fs; clusterSize := fs.vol(FATVolumes.Volume).clusterSize; writeEOC := FALSE; eocCluster := NotAssigned;
  565. END Init;
  566. (* Position a Rider at a certain position in a file. Multiple Riders can be positioned at different locations in a file.
  567. A Rider cannot be positioned beyond the end of a file. *)
  568. PROCEDURE Set*(VAR r: Files.Rider; pos: LONGINT);
  569. BEGIN {EXCLUSIVE} SetX(r, pos)
  570. END Set;
  571. PROCEDURE SetX(VAR r: Files.Rider; pos: LONGINT);
  572. BEGIN
  573. r.eof := FALSE; r.res := 0; r.file := SELF; r.fs := fs;
  574. IF (pos < 0) THEN pos := 0
  575. ELSIF (pos > size) THEN pos := size
  576. END;
  577. r.apos := pos DIV clusterSize;
  578. r.bpos := pos MOD clusterSize;
  579. IF (buffer = NIL) THEN
  580. NEW(buffer); NEW(buffer.data, clusterSize);
  581. buffer.pos := NotAssigned;
  582. buffer.eoc := (cluster < 2);
  583. END;
  584. END SetX;
  585. (* Return the offset of a Rider positioned on a file. *)
  586. PROCEDURE Pos*(VAR r: Files.Rider): LONGINT;
  587. BEGIN RETURN r.apos*clusterSize + r.bpos
  588. END Pos;
  589. (* Read logical cluster 'pos', pos=0 is the first cluster. 'pos' must be <= # of clusters in file.
  590. If pos=# of cluster in file then a new cluster will be allocated when the buffer is written back to disk.
  591. buf.cluster contains the physical cluster # (>= 2), -(the physical cluster # of the last cluster of the file),
  592. or EOC if the file has no clusters assigned yet.
  593. *)
  594. PROCEDURE ReadBuffer(buffer: Buffer; pos: LONGINT);
  595. VAR
  596. last: Address;
  597. i: LONGINT; res: WORD;
  598. bp, bc, ctrlflow, stopc: LONGINT;
  599. BEGIN
  600. ASSERT(buffer.pos # pos);
  601. bp := buffer.pos; bc := buffer.cluster;
  602. (* We need to find the cluster number <pos> or possible allocate a new cluster and append it to the file's cluster chain.
  603. Start searching at... *)
  604. IF (buffer.pos # NotAssigned) & (buffer.pos < pos) THEN
  605. (* the currently loaded cluster *)
  606. last := buffer.cluster;
  607. ctrlflow := 1;
  608. ELSE
  609. (* the first cluster of this file *)
  610. buffer.pos := 0; buffer.cluster := cluster; last := cluster;
  611. ctrlflow := 2;
  612. END;
  613. (* Follow the cluster chain described in the FAT *)
  614. WHILE (buffer.pos < pos) & (buffer.cluster >= 2) DO
  615. last := buffer.cluster;
  616. buffer.cluster := fs.vol(FATVolumes.Volume).ReadFATEntry(last);
  617. INC(buffer.pos)
  618. END;
  619. IF (buffer.pos < pos) THEN stopc := 1 END;
  620. IF (buffer.cluster >= 2) THEN stopc := stopc + 10 END;
  621. IF (pos # buffer.pos) THEN (* we are going to TRAP, give some additional info to track down the bug *)
  622. KernelLog.Enter;
  623. KernelLog.String("ReadBuffer failed"); KernelLog.Ln;
  624. KernelLog.String(" file: "); KernelLog.String(long); KernelLog.Ln;
  625. KernelLog.String(" size: "); KernelLog.Int(size, 0); KernelLog.Ln;
  626. KernelLog.String(" cluster size: "); KernelLog.Int(clusterSize, 0); KernelLog.Ln;
  627. KernelLog.String(" cluster: "); KernelLog.Int(cluster, 0); KernelLog.Ln;
  628. KernelLog.String(" parent: "); KernelLog.Int(parent, 0); KernelLog.Ln;
  629. KernelLog.String(" requested position: "); KernelLog.Int(pos, 0); KernelLog.Ln;
  630. KernelLog.String(" buffer.pos on entry: "); KernelLog.Int(bp, 0); KernelLog.Ln;
  631. KernelLog.String(" buffer.cluster on entry: "); KernelLog.Int(bc, 0); KernelLog.Ln;
  632. KernelLog.String(" control flow: "); KernelLog.Int(ctrlflow, 0); KernelLog.Ln;
  633. KernelLog.String(" stop condition: "); KernelLog.Int(stopc, 0); KernelLog.Ln;
  634. KernelLog.String(" buffer.pos: "); KernelLog.Int(buffer.pos, 0); KernelLog.Ln;
  635. KernelLog.String(" buffer.cluster: "); KernelLog.Int(buffer.cluster, 0); KernelLog.Ln;
  636. KernelLog.String(" buffer.eoc: "); KernelLog.Boolean(buffer.eoc); KernelLog.Ln;
  637. KernelLog.String(" last: "); KernelLog.Int(last, 0); KernelLog.Ln;
  638. KernelLog.String(" cluster chain:"); KernelLog.Int(cluster, 0); KernelLog.Char(" ");
  639. bp := cluster;
  640. WHILE (bp >= 2) DO
  641. bp := fs.vol(FATVolumes.Volume).ReadFATEntry(bp);
  642. KernelLog.Int(bp, 0); KernelLog.Char(" ")
  643. END;
  644. KernelLog.Ln;
  645. KernelLog.Exit
  646. END;
  647. ASSERT(pos = buffer.pos);
  648. IF (buffer.cluster = EOC) OR (buffer.cluster = FREE) THEN
  649. (* Allocate new cluster when writing back the buffer. IF (-last # EOC) & (-last # FREE), create a new FAT entry
  650. -last -> cluster number of newly allocated buffer *)
  651. buffer.cluster := -last; (* remember previous cluster (= last cluster of file) *)
  652. FOR i := 0 TO clusterSize-1 DO buffer.data[i] := 0X END
  653. ELSE
  654. (* Just read the existing cluster *)
  655. fs.vol(FATVolumes.Volume).ReadCluster(buffer.cluster, buffer.data^, res);
  656. buffer.eoc := FALSE;
  657. ASSERT(res = Ok)
  658. END
  659. END ReadBuffer;
  660. (* Write logical cluster. Depending on buf.cluster, a new physical cluster may be allocated. cf. ReadBuffer *)
  661. PROCEDURE WriteBuffer(buffer: Buffer);
  662. VAR link: Address; res: WORD;
  663. BEGIN
  664. IF (buffer.cluster < 2) THEN (* allocate new cluster *)
  665. IF (buffer.cluster = -EOC) THEN link := FATVolumes.FREE
  666. ELSE link := -buffer.cluster; ASSERT(link >= 2)
  667. END;
  668. buffer.cluster := fs.vol(FATVolumes.Volume).AllocCluster(link, res);
  669. IF (res # Ok) THEN
  670. IF (res = FATVolumes.ErrDiskFull) THEN
  671. KernelLog.Enter; KernelLog.String(fs.prefix); KernelLog.String(": disk full"); KernelLog.Exit;
  672. HALT(FATVolumes.ErrDiskFull)
  673. ELSE HALT(ErrIOError)
  674. END
  675. END;
  676. buffer.eoc := TRUE;
  677. IF (link = FATVolumes.FREE) THEN cluster := buffer.cluster; modH := TRUE END; (* first cluster of file allocated *)
  678. writeEOC := TRUE; eocCluster := buffer.cluster
  679. END;
  680. ASSERT((buffer.cluster >= 2) & (buffer.pos >= 0) & (LEN(buffer.data) = clusterSize));
  681. fs.vol(FATVolumes.Volume).WriteCluster(buffer.cluster, buffer.data^, res);
  682. ASSERT(res = Ok)
  683. END WriteBuffer;
  684. (* Read a byte from a file, advancing the Rider one byte further. R.eof indicates if the end of the file has been passed. *)
  685. PROCEDURE Read*(VAR r: Files.Rider; VAR x: CHAR);
  686. BEGIN {EXCLUSIVE} ReadX(r, x)
  687. END Read;
  688. PROCEDURE ReadX(VAR r: Files.Rider; VAR x: CHAR);
  689. BEGIN
  690. IF (r.apos*clusterSize + r.bpos < size) THEN
  691. IF (buffer.pos # r.apos) THEN ReadBuffer(buffer, r.apos) END;
  692. x := buffer.data[r.bpos];
  693. INC(r.bpos);
  694. IF (r.bpos = clusterSize) THEN INC(r.apos); r.bpos := 0 END
  695. ELSE
  696. x := 0X; r.eof := TRUE
  697. END
  698. END ReadX;
  699. (* Read a sequence of len bytes into the buffer x at offset ofs, advancing the Rider. Less bytes will be read when
  700. reading over the end of the file. r.res indicates the number of unread bytes. x must be big enough to hold all the bytes. *)
  701. PROCEDURE ReadBytes*(VAR r: Files.Rider; VAR x: ARRAY OF CHAR; ofs, len: LONGINT);
  702. BEGIN {EXCLUSIVE} ReadBytesX(r, x, ofs, len)
  703. END ReadBytes;
  704. PROCEDURE ReadBytesX(VAR r: Files.Rider; VAR x: ARRAY OF CHAR; ofs, len: LONGINT);
  705. VAR src: ADDRESS; m: LONGINT;
  706. BEGIN
  707. IF LEN(x)-ofs < len THEN SYSTEM.HALT(19) END;
  708. IF len > 0 THEN
  709. WHILE (len > 0) & (Pos(r) < size) DO
  710. IF (buffer.pos # r.apos) THEN ReadBuffer(buffer, r.apos) END;
  711. src := ADDRESSOF(buffer.data[r.bpos]);
  712. m := MIN(MIN(size - Pos(r), clusterSize - r.bpos), len);
  713. SYSTEM.MOVE(src, ADDRESSOF(x[ofs]), m);
  714. INC(ofs, m); DEC(len, m);
  715. INC(r.bpos, m); ASSERT(r.bpos <= clusterSize);
  716. IF (r.bpos = clusterSize) THEN INC(r.apos); r.bpos := 0 END;
  717. END;
  718. r.res := len; r.eof := Pos(r) = size
  719. ELSE
  720. r.res := 0
  721. END
  722. END ReadBytesX;
  723. (* Write a byte into the file at the Rider position, advancing the Rider by one. *)
  724. PROCEDURE Write*(VAR r: Files.Rider; x: CHAR);
  725. BEGIN {EXCLUSIVE} WriteX(r, x)
  726. END Write;
  727. PROCEDURE WriteX(VAR r: Files.Rider; x: CHAR);
  728. BEGIN
  729. IF (attr * WriteProtected # {}) THEN HALT(ErrFileReadOnly) END;
  730. IF (buffer.pos # r.apos) THEN ReadBuffer(buffer, r.apos) END;
  731. buffer.data[r.bpos] := x;
  732. INC(r.bpos);
  733. IF (r.bpos = clusterSize) THEN INC(r.apos); r.bpos := 0 END;
  734. IF (Pos(r) > size) THEN
  735. ASSERT(Pos(r) = size+1); size := Pos(r);
  736. IF ~(SELF IS Directory) THEN modH := TRUE END
  737. END;
  738. WriteBuffer(buffer)
  739. END WriteX;
  740. (* Write the buffer x containing len bytes (starting at offset ofs) into a file at the Rider position. *)
  741. PROCEDURE WriteBytes*(VAR r: Files.Rider; CONST x: ARRAY OF CHAR; ofs, len: LONGINT);
  742. BEGIN {EXCLUSIVE} WriteBytesX(r, x, ofs, len)
  743. END WriteBytes;
  744. PROCEDURE WriteBytesX(VAR r: Files.Rider; CONST x: ARRAY OF CHAR; ofs, len: LONGINT);
  745. VAR dst: ADDRESS; m: LONGINT;
  746. BEGIN
  747. IF (attr * WriteProtected # {}) THEN HALT(ErrFileReadOnly) END;
  748. IF LEN(x)-ofs < len THEN SYSTEM.HALT(19) END;
  749. IF len > 0 THEN
  750. WHILE (len > 0) DO
  751. IF (buffer.pos # r.apos) THEN ReadBuffer(buffer, r.apos) END;
  752. dst := ADDRESSOF(buffer.data[r.bpos]);
  753. m := MIN(clusterSize-r.bpos, len);
  754. SYSTEM.MOVE(ADDRESSOF(x[ofs]), dst, m);
  755. WriteBuffer(buffer);
  756. INC(ofs, m); DEC(len, m);
  757. INC(r.bpos, m); ASSERT(r.bpos <= clusterSize);
  758. IF (r.bpos = clusterSize) THEN INC(r.apos); r.bpos := 0 END;
  759. END;
  760. IF (Pos(r) > size) THEN
  761. size := Pos(r);
  762. IF ~(SELF IS Directory) THEN modH := TRUE END
  763. END
  764. END
  765. END WriteBytesX;
  766. (* Return the current length of a file. *)
  767. PROCEDURE Length*(): LONGINT;
  768. BEGIN
  769. (* Length() should in principle be exlusive, however it won't do any harm if it is not, it just reflects the
  770. current size if called from outside. Internal methods that call Length() are exclusive whenever needed *)
  771. RETURN size
  772. END Length;
  773. (* Return the time (t) and date (d) when a file was last modified. *)
  774. PROCEDURE GetDate*(VAR t, d: LONGINT);
  775. BEGIN {EXCLUSIVE}
  776. t := writeTime; d := writeDate;
  777. END GetDate;
  778. (* Set the modification time (t) and date (d) of a file. *)
  779. PROCEDURE SetDate*(t, d: LONGINT);
  780. BEGIN {EXCLUSIVE}
  781. writeTime := t; writeDate := d; modH := TRUE;
  782. END SetDate;
  783. (** Return the file attributes *)
  784. PROCEDURE GetAttributes*(): SET;
  785. BEGIN {EXCLUSIVE}
  786. RETURN attr
  787. END GetAttributes;
  788. (** Set the file attributes *)
  789. PROCEDURE SetAttributes*(Attr: SET);
  790. BEGIN {EXCLUSIVE}
  791. Attr := Attr * faValidMask;
  792. attr := attr - faValidMask + Attr;
  793. modH := TRUE
  794. END SetAttributes;
  795. (** Adds 'Attr' to the file's attributes *)
  796. PROCEDURE InclAttribute*(Attr: LONGINT);
  797. BEGIN {EXCLUSIVE}
  798. IF (Attr IN faValidMask) & ~(Attr IN attr) THEN
  799. INCL(attr, Attr);
  800. modH := TRUE
  801. END
  802. END InclAttribute;
  803. (** Removes 'Attr' from the file's attributes *)
  804. PROCEDURE ExclAttribute*(Attr: LONGINT);
  805. BEGIN {EXCLUSIVE}
  806. IF (Attr IN faValidMask) & (Attr IN attr) THEN
  807. EXCL(attr, Attr);
  808. modH := TRUE
  809. END
  810. END ExclAttribute;
  811. (* Return the canonical name of a file. *)
  812. PROCEDURE GetName*(VAR name: ARRAY OF CHAR);
  813. BEGIN (* {GetFullName is EXCLUSIVE} *)
  814. GetFullName(name, TRUE)
  815. END GetName;
  816. (* Register a file created with New in the directory, replacing the previous file in the directory with the same name.
  817. The file is automatically updated. End users use Files.Register instead. *)
  818. PROCEDURE Register0*(VAR res: WORD);
  819. VAR dir: Directory; old: File; s: SearchByName;
  820. BEGIN {EXCLUSIVE}
  821. IF ~registered THEN
  822. dir := fs(FileSystem).GetDirectoryX(parent);
  823. IF (dir = NIL) THEN HALT(ErrParentNotFound) END; (* uaahhh...this is bad *)
  824. old := dir.Find(long);
  825. IF (old # NIL) THEN
  826. IF (old IS Directory) THEN res := ErrDirectoryProtection; RETURN
  827. ELSE
  828. NEW(s, old.parent, old.long); fs(FileSystem).openFiles.Enumerate(s.EnumFile);
  829. IF (s.found = NIL) THEN old.DeleteClusterChain(res) (* file not open, remove cluster chain (ignore res) *)
  830. ELSE (* file open, unregister *)
  831. old.registered := FALSE;
  832. fs(FileSystem).anonymousFiles.Add(old, PurgeFile)
  833. END;
  834. (* recycle file header, do not dir.RemoveFileHeader(old) ! *)
  835. entry := old.entry; short := old.short;
  836. modName := FALSE
  837. END
  838. END;
  839. registered := TRUE;
  840. UpdateX;
  841. IF (cluster = NotAssigned) THEN key := fs(FileSystem).GetNextFileKey()
  842. ELSE key := cluster
  843. END;
  844. fs(FileSystem).anonymousFiles.Remove(SELF);
  845. res := 0
  846. ELSE
  847. res := 1
  848. END
  849. END Register0;
  850. (* Flush the changes made to a file from its buffers. Register0 will automatically update a file. *)
  851. PROCEDURE Update*;
  852. BEGIN {EXCLUSIVE} UpdateX
  853. END Update;
  854. PROCEDURE UpdateX;
  855. VAR dir: Directory;
  856. BEGIN
  857. IF registered & modH THEN
  858. dir := fs(FileSystem).GetDirectoryX(parent);
  859. IF (dir = NIL) THEN HALT(ErrParentNotFound) END; (* uaahhh...this is bad *)
  860. dir.WriteFileHeader(SELF)
  861. END
  862. END UpdateX;
  863. PROCEDURE DeleteClusterChain(VAR res: WORD);
  864. BEGIN {EXCLUSIVE}
  865. UpdateX;
  866. fs.vol(FATVolumes.Volume).FreeClusterChain(cluster, res);
  867. cluster := NotAssigned; size := 0
  868. END DeleteClusterChain;
  869. PROCEDURE GetFullName*(VAR name: ARRAY OF CHAR; WithPrefix: BOOLEAN);
  870. VAR pos, i: LONGINT;
  871. PROCEDURE Get(directory: Address);
  872. VAR dir: Directory; k: LONGINT;
  873. BEGIN
  874. dir := fs(FileSystem).GetDirectoryX(directory);
  875. IF ~(dir = fs(FileSystem).rootDir) THEN
  876. dir.Initialize;
  877. Get(dir.parent)
  878. END;
  879. k := 0;
  880. WHILE (dir.long[k] # 0X) & (pos < LEN(name)) DO
  881. name[pos] := dir.long[k];
  882. INC(pos); INC(k)
  883. END;
  884. IF (pos < LEN(name)) THEN name[pos] := PathDelimiter; INC(pos) END
  885. END Get;
  886. BEGIN {EXCLUSIVE}
  887. pos := 0; i := 0;
  888. IF WithPrefix THEN
  889. WHILE (fs.prefix[i] # 0X) & (pos < LEN(name)) DO
  890. name[pos] := fs.prefix[i];
  891. INC(pos); INC(i)
  892. END;
  893. name[pos] := ":"; INC(pos)
  894. END;
  895. IF (SELF = fs(FileSystem).rootDir) THEN
  896. name[pos] := PathDelimiter; INC(pos)
  897. ELSIF (pos < LEN(name)) THEN
  898. Get(parent);
  899. i := 0;
  900. WHILE (long[i] # 0X) & (pos < LEN(name)) DO
  901. name[pos] := long[i];
  902. INC(pos); INC(i)
  903. END;
  904. IF (faDirectory IN attr) & (pos < LEN(name)) THEN
  905. name[pos] := PathDelimiter; INC(pos)
  906. END
  907. END;
  908. name[MIN(LEN(name)-1, pos)] := 0X
  909. END GetFullName;
  910. END File;
  911. TYPE
  912. NameParam = POINTER TO RECORD(Parameter)
  913. name: Filename;
  914. file: File
  915. END;
  916. ClusterParam = POINTER TO RECORD(Parameter)
  917. cluster: Address;
  918. file: File
  919. END;
  920. ResultParam = POINTER TO RECORD(Parameter)
  921. res: WORD
  922. END;
  923. TailGenParam = POINTER TO RECORD(Parameter)
  924. short: Shortname; (* holds the short name *)
  925. tailmask: SET; (* defines what tail lengths we are checking *)
  926. tails: POINTER TO ARRAY OF SET; (* bit-array, if a tail is found the corresponding bit is set *)
  927. END;
  928. EnumCallback* = PROCEDURE {DELEGATE} (f: File; par: Parameter): BOOLEAN;
  929. Directory* = OBJECT(File)
  930. VAR
  931. firstFreePos: LONGINT; (* position of first known free entry in directory, 'NotAssigned' if unknown *)
  932. extendable: BOOLEAN; (* TRUE if the directory can grow *)
  933. PROCEDURE &Init*(fs: Files.FileSystem);
  934. BEGIN
  935. Init^(fs);
  936. attr := {faDirectory, faReadOnly};
  937. parent := NotAssigned;
  938. firstFreePos := MAX(LONGINT);
  939. extendable := TRUE
  940. END Init;
  941. PROCEDURE Initialize;
  942. VAR r: Files.Rider; data: ARRAY 32 OF CHAR; parentDir: Directory; f: File;
  943. BEGIN {EXCLUSIVE}
  944. IF (parent = NotAssigned) THEN (* find parent *)
  945. SetX(r, 32);
  946. ReadBytesX(r, data, 0, 32);
  947. IF (r.res # 0) THEN HALT(ErrIOError) END;
  948. (* make sure it's the ".." entry *)
  949. IF (data[0] # ".") OR (data[1] # ".") OR (data[2] # " ") THEN HALT(ErrParentNotFound) END;
  950. parent := 10000H*FATVolumes.GetUnsignedInteger(data, 20) + FATVolumes.GetUnsignedInteger(data, 26)
  951. END;
  952. IF (parent = 0) THEN parentDir := fs(FileSystem).rootDir
  953. ELSE NEW(parentDir, fs); parentDir.cluster := parent
  954. END;
  955. f := parentDir.FindByCluster(cluster);
  956. IF (f = NIL) OR ~(f IS Directory) THEN HALT(ErrParentNotFound) END;
  957. long := f.long; short := f.short; attr := f.attr; NTres := f.NTres;
  958. time := f.time; date := f.date; writeTime := f.writeTime; writeDate := f.writeDate; accessDate := f.accessDate;
  959. modH := FALSE; modName := FALSE; registered := TRUE;
  960. clusterSize := f.clusterSize;
  961. InitSize
  962. END Initialize;
  963. PROCEDURE InitSize;
  964. VAR c: Address; vol: FATVolumes.Volume;
  965. (* TRAP info *)
  966. tiFilename: Filename; tiFirstCluster, tiThisCluster, tiSize: LONGINT;
  967. BEGIN
  968. vol := fs.vol(FATVolumes.Volume);
  969. c := cluster; size := 0;
  970. IF (cluster # NotAssigned) THEN
  971. COPY(long, tiFilename); tiFirstCluster := c;
  972. REPEAT
  973. tiThisCluster := c; tiSize := size;
  974. c := vol.ReadFATEntry(c);
  975. INC(size, clusterSize)
  976. UNTIL (c < 2);
  977. IF (c # EOC) THEN
  978. KernelLog.Enter; KernelLog.String(moduleName); KernelLog.String("warning: cluster chain of directory '"); KernelLog.String(long);
  979. KernelLog.String("' not terminated!"); KernelLog.Exit
  980. END;
  981. END;
  982. ASSERT(size > 0)
  983. END InitSize;
  984. (* Position a Rider at a certain position in a file. Multiple Riders can be positioned at different locations in a file.
  985. A Rider cannot be positioned beyond the end of a file. *)
  986. PROCEDURE SetX(VAR r: Files.Rider; pos: LONGINT);
  987. BEGIN
  988. IF (size = 0) THEN InitSize END;
  989. SetX^(r, pos)
  990. END SetX;
  991. (* Return the current length of a file. *)
  992. PROCEDURE Length*(): LONGINT;
  993. BEGIN {EXCLUSIVE}
  994. IF (size = 0) THEN InitSize END;
  995. RETURN Length^()
  996. END Length;
  997. (* Enumerate - enumerates the contents of the directory *)
  998. PROCEDURE Enumerate(enum: EnumCallback; par: Parameter);
  999. BEGIN {EXCLUSIVE} EnumerateX(enum, TRUE, par)
  1000. END Enumerate;
  1001. PROCEDURE EnumerateX(enum: EnumCallback; parseLong: BOOLEAN; par: Parameter);
  1002. VAR data: ARRAY 32 OF CHAR; cont: BOOLEAN;
  1003. type, i, k, chksumI, chksumII: LONGINT;
  1004. file, f: File; dir: Directory; r: Files.Rider; entry: DirEntry;
  1005. attr: SET; unicode: ARRAY 261 OF LONGINT; longname: Filename;
  1006. BEGIN
  1007. NEW(file, fs); NEW(dir, fs);
  1008. SetX(r, 0);
  1009. cont := TRUE; firstFreePos := MAX(LONGINT);
  1010. REPEAT
  1011. ReadBytesX(r, data, 0, 32);
  1012. IF (data[0] = deFree) THEN (* free entry *)
  1013. IF (Pos(r) < firstFreePos) THEN firstFreePos := Pos(r)-32 END
  1014. ELSIF (data[0] # deLast) THEN (* long/short directory entry *)
  1015. type := FATVolumes.AND(3FH, ORD(data[11]));
  1016. longname := "";
  1017. entry.ofs := Pos(r) - 32; entry.len := 1;
  1018. IF (type = faLongName) THEN
  1019. k := -1;
  1020. IF parseLong & (FATVolumes.AND(40H, ORD(data[0])) = 40H) THEN
  1021. k := ORD(data[0]) MOD 40H - 1; (* number of long entries - 1 *)
  1022. data[0] := CHR(k+1); (* = mask out 40H from data[0] *)
  1023. chksumI := ORD(data[13]);
  1024. unicode[13*(k+1)] := 0;
  1025. WHILE (k >= 0) & (k+1 = ORD(data[0])) &
  1026. (FATVolumes.AND(3FH, ORD(data[11])) = faLongName) & (chksumI = ORD(data[13])) DO
  1027. FOR i := 0 TO 4 DO unicode[13*k + i] := FATVolumes.GetUnsignedInteger(data, 1 + 2*i) END;
  1028. FOR i := 0 TO 5 DO unicode[13*k + 5 + i] := FATVolumes.GetUnsignedInteger(data, 14 + 2*i) END;
  1029. FOR i := 0 TO 1 DO unicode[13*k + 11 + i] := FATVolumes.GetUnsignedInteger(data, 28 + 2*i) END;
  1030. DEC(k);
  1031. INC(entry.len);
  1032. ReadBytesX(r, data, 0, 32)
  1033. END
  1034. (* k # 0 -> Error *)
  1035. END;
  1036. IF (k <= 0) THEN UTF8Strings.UnicodetoUTF8(unicode, longname)
  1037. ELSE (* k # 0; skip over orphaned long entries *)
  1038. WHILE (FATVolumes.AND(3FH, ORD(data[11])) = faLongName) DO ReadBytesX(r, data, 0, 32) END;
  1039. entry.len := 1
  1040. END
  1041. END;
  1042. IF (data[0] = deFree) OR (data[0] = deLast) THEN
  1043. (* the long entry was ok, but the short entry is free -> this happens when a FAT driver that does not support long names
  1044. deletes a file -> ignore entry *)
  1045. IF (entry.ofs < firstFreePos) THEN firstFreePos := entry.ofs END
  1046. ELSE
  1047. (* short entry *)
  1048. attr := SYSTEM.VAL(SET, LONG(ORD(data[11])));
  1049. IF ~(faVolumeID IN attr) THEN
  1050. (* ignore "." and ".." entries *)
  1051. IF ~((faDirectory IN attr) & (data[0] = ".") & ((data[1] = " ") OR ((data[1] = ".") & (data[2] = " ")))) THEN
  1052. IF (faDirectory IN attr) THEN f := dir; attr := attr + {faReadOnly}; f.flags := {Files.Directory}
  1053. ELSE f := file; f.flags := {}
  1054. END;
  1055. f.long := longname;
  1056. i := 0; k := 0; chksumII := 0;
  1057. FOR i := 0 TO 10 DO
  1058. f.short[i] := data[i];
  1059. IF ODD(chksumII) THEN chksumII := 80H + chksumII DIV 2 ELSE chksumII := chksumII DIV 2 END;
  1060. chksumII := (chksumII + ORD(data[i])) MOD 100H;
  1061. END;
  1062. f.short[11] := 0X;
  1063. f.long := "";
  1064. f.attr := attr;
  1065. f.NTres := data[12];
  1066. f.cluster := 10000H*FATVolumes.GetUnsignedInteger(data, 20) + FATVolumes.GetUnsignedInteger(data, 26);
  1067. f.parent := cluster;
  1068. f.size := FATVolumes.GetLongint(data, 28);
  1069. f.time := TimeFAT2Oberon(FATVolumes.GetUnsignedInteger(data, 14), ORD(data[13]));
  1070. f.date := DateFAT2Oberon(FATVolumes.GetUnsignedInteger(data, 16));
  1071. f.writeTime := TimeFAT2Oberon(FATVolumes.GetUnsignedInteger(data, 22), 0);
  1072. f.writeDate := DateFAT2Oberon(FATVolumes.GetUnsignedInteger(data, 24));
  1073. f.accessDate := DateFAT2Oberon(FATVolumes.GetUnsignedInteger(data, 18));
  1074. f.modH := FALSE; f.modName := FALSE;
  1075. f.registered := TRUE;
  1076. IF (longname # "") & (chksumI # chksumII) THEN (* chksum mismatch, ignore long name *)
  1077. IF (entry.ofs < firstFreePos) THEN firstFreePos := entry.ofs END;
  1078. longname := ""; f.entry.ofs := Pos(r) - 32; f.entry.len := 1
  1079. ELSE f.long := longname; f.entry := entry
  1080. END;
  1081. IF (f.long = "") THEN
  1082. i := 0;
  1083. WHILE (i < 8) DO f.long[i] := f.short[i]; INC(i) END;
  1084. WHILE (i > 0) & (f.long[i-1] = " ") DO DEC(i) END;
  1085. IF (f.short[8] # " ") THEN
  1086. f.long[i] := "."; INC(i);
  1087. k := 8;
  1088. WHILE (k < 11) & (f.short[k] # " ") DO f.long[i] := f.short[k]; INC(i); INC(k) END
  1089. END;
  1090. f.long[i] := 0X
  1091. END;
  1092. cont := enum(f, par)
  1093. END
  1094. ELSE (* set volume name *)
  1095. i := 0;
  1096. WHILE (i < 11) & (data[i] # " ") DO fs.vol.name[i] := data[i]; INC(i) END;
  1097. fs.vol.name[i] := 0X
  1098. END
  1099. END
  1100. END
  1101. UNTIL (data[0] = deLast) OR r.eof OR ~cont;
  1102. IF (firstFreePos = MAX(LONGINT)) THEN firstFreePos := MAX(Pos(r)-32, 0) END;
  1103. ASSERT(firstFreePos MOD 32 = 0)
  1104. END EnumerateX;
  1105. (* TailGeneration - generates a short name that does not collide with an existing long or short name *)
  1106. PROCEDURE TailGenHandler(f: File; p: Parameter): BOOLEAN;
  1107. VAR i,k: INTEGER;
  1108. tail: LONGINT;
  1109. BEGIN
  1110. WITH p: TailGenParam DO
  1111. (* compare names *)
  1112. i := 0; WHILE (i < 8) & (f.short[i] = p.short[i]) DO INC(i) END;
  1113. k := 8; WHILE (k < 11) & (f.short[k] = p.short[k]) DO INC(k) END;
  1114. IF (k = 11) THEN
  1115. IF (i = 8) THEN INCL(p.tails[0], 0) (* identical filename *)
  1116. ELSE
  1117. IF (f.short[i] = "~") THEN
  1118. INCL(p.tails[0], 0); (* identical filename flag *)
  1119. (* extract tail value and calculate offset in bit array *)
  1120. tail := 0; k := i+1;
  1121. WHILE (k < 8) & (f.short[k] >= "0") & (f.short[k] <= "9") DO
  1122. tail := 10*tail + ORD(f.short[k]) - ORD("0");
  1123. INC(k)
  1124. END;
  1125. (* set bit in bitmask *)
  1126. IF (tail DIV 32 < LEN(p.tails)) THEN
  1127. (* tails of the form [0]+[1-9]+ will be mapped to the same spot as
  1128. the tail without the leading 0. We do not generate tails with
  1129. leading zeros, so we can safely ignore that here. *)
  1130. INCL(p.tails[tail DIV 32], tail MOD 32)
  1131. END
  1132. END
  1133. END
  1134. END
  1135. END;
  1136. RETURN TRUE
  1137. END TailGenHandler;
  1138. PROCEDURE TailFinder(p: TailGenParam; VAR tail: LONGINT): BOOLEAN;
  1139. VAR delta,i,l,max: LONGINT;
  1140. BEGIN
  1141. (* calculate size of bit-array and initialize it *)
  1142. max := 0; delta := 10;
  1143. FOR l := 1 TO 6 DO
  1144. IF (l IN p.tailmask) THEN max := delta END;
  1145. delta := delta * 10
  1146. END;
  1147. NEW(p.tails, (max + 31) DIV 32);
  1148. FOR i := 0 TO LEN(p.tails)-1 DO p.tails[i] := {} END;
  1149. (* seach directory *)
  1150. INCL(p.tailmask, 0);
  1151. EnumerateX(TailGenHandler, FALSE, p); (* ignore long names *)
  1152. (* try to find a free tail number *)
  1153. tail := 0;
  1154. IF (0 IN p.tails[0]) THEN (* bit 0 in p.tails[0] indicates wheter we have found a tail or not *)
  1155. FOR i := 0 TO LEN(p.tails)-1 DO
  1156. IF (p.tails[i] # {0..31}) THEN
  1157. FOR l := 0 TO 31 DO
  1158. IF ~(l IN p.tails[i]) THEN
  1159. tail := i*32+l; RETURN TRUE
  1160. END
  1161. END
  1162. END
  1163. END
  1164. ELSE RETURN TRUE
  1165. END;
  1166. RETURN FALSE
  1167. END TailFinder;
  1168. PROCEDURE TailGeneration(VAR shortname: Shortname; TailNeeded: BOOLEAN);
  1169. VAR tp: TailGenParam; len, max, pos, tail: LONGINT; dummy: BOOLEAN;
  1170. BEGIN
  1171. NEW(tp);
  1172. tp.short := shortname;
  1173. (* first, we look for tails with lengths 1,2,3, or 4 (~x, ~xx, ~xxx, ~xxxx) *)
  1174. tp.tailmask := {1, 2, 3, 4};
  1175. IF ~TailFinder(tp, tail) THEN
  1176. (* wow, more than 10'000 files with the same shortname in one directory.... *)
  1177. tp.tailmask := {5,6};
  1178. dummy := TailFinder(tp, tail)
  1179. END;
  1180. IF TailNeeded OR (0 IN tp.tails[0]) THEN
  1181. IF (tail = 0) & TailNeeded THEN tail := 1 END;
  1182. IF (tail # 0) THEN (* tail found *)
  1183. (* calc length of tail *)
  1184. len := 1; max := 10; WHILE (max-1 < tail) DO max := max*10; INC(len) END;
  1185. (* insert tail, avoid spaces in short name *)
  1186. pos := 7-len;
  1187. WHILE (pos > 0) & (shortname[pos-1] = " ") DO DEC(pos) END;
  1188. shortname[pos] := "~";
  1189. WHILE (len > 0) DO
  1190. shortname[pos+len] := CHR(ORD("0") + tail MOD 10);
  1191. tail := tail DIV 10;
  1192. DEC(len)
  1193. END
  1194. ELSE
  1195. (* argh, all possible tails (= 1111105 !) occupied. Raise "You are a Moron" exception *)
  1196. KernelLog.Enter;
  1197. KernelLog.String(moduleName); KernelLog.String("Too many files with similar names");
  1198. KernelLog.Exit;
  1199. HALT(ErrTooManySimilarFiles)
  1200. END
  1201. END
  1202. END TailGeneration;
  1203. PROCEDURE GetShortName(VAR name: Filename; VAR shortname: Shortname; VAR checksum: CHAR);
  1204. VAR extPos, i, k: LONGINT; ascii: ARRAY 256 OF CHAR; lossy, l, sameName: BOOLEAN;
  1205. BEGIN
  1206. (* step 1-4: convert name to upper case OEM (ASCII), set 'lossy conversion'-flag, strip leading and embedded spaces, strip leading periods.
  1207. also remember, if the long name has an extension and the position of its first character *)
  1208. lossy := UTF8Strings.UTF8toASCII(name, 0X, ascii) > 0;
  1209. WHILE (i < 256) & (ascii[i] # 0X) DO
  1210. ascii[k] := UpperCh(ascii[i], l);
  1211. IF l THEN ascii[k] := "_"; lossy := TRUE END;
  1212. IF (ascii[k] # " ") & ((ascii[k] # ".") OR (k > 0)) THEN INC(k) END; (* ignore spaces and dots at the beginning of the name *)
  1213. IF (ascii[k] = ".") THEN extPos := k END;
  1214. INC(i)
  1215. END;
  1216. (* step 5: copy primary portion of name *)
  1217. FOR i := 0 TO 10 DO shortname[i] := " " END;
  1218. i := 0;
  1219. WHILE (ascii[i] # 0X) & (ascii[i] # ".") & (i < 8) DO shortname[i] := ascii[i]; INC(i) END;
  1220. IF (i < 8) & ((ascii[i] = 0X) OR (extPos = i)) THEN sameName := TRUE END;
  1221. (* step 6: omitted *)
  1222. (* step 7: copy extension *)
  1223. IF (extPos > 0) THEN
  1224. i := 0; INC(extPos);
  1225. WHILE (ascii[extPos + i] # 0X) & (i < 3) DO shortname[8+i] := ascii[extPos+i]; INC(i) END;
  1226. IF (i = 3) & (ascii[extPos+i] # 0X) THEN sameName := FALSE END
  1227. END;
  1228. (* numeric tail generation *)
  1229. TailGeneration(shortname, TRUE (*lossy OR sameName*));
  1230. (*
  1231. KernelLog.String(moduleName); KernelLog.String("GetShortName(): '"); KernelLog.String(name);
  1232. KernelLog.String("' ==> '"); KernelLog.String(shortname); KernelLog.Char("'"); KernelLog.Ln;
  1233. *)
  1234. checksum := CheckSum(shortname)
  1235. END GetShortName;
  1236. PROCEDURE RemoveFileHeader(f: File);
  1237. BEGIN {EXCLUSIVE} RemoveFileHeaderX(f)
  1238. END RemoveFileHeader;
  1239. PROCEDURE RemoveFileHeaderX(f: File);
  1240. VAR ofs, i: LONGINT; r: Files.Rider; ro: BOOLEAN;
  1241. BEGIN
  1242. IF (faReadOnly IN attr) THEN EXCL(attr, faReadOnly); ro := TRUE END;
  1243. IF (f.entry.len > 0) THEN
  1244. ofs := f.entry.ofs;
  1245. ASSERT((ofs # NotAssigned) & (ofs MOD 32 = 0));
  1246. IF (ofs < firstFreePos) THEN firstFreePos := ofs END;
  1247. FOR i := 0 TO f.entry.len-1 DO
  1248. SetX(r, ofs);
  1249. WriteX(r, deFree);
  1250. INC(ofs, 32)
  1251. END;
  1252. UpdateX
  1253. END;
  1254. f.entry.ofs := NotAssigned; f.entry.len := 0;
  1255. f.registered := FALSE;
  1256. IF ro THEN INCL(attr, faReadOnly) END
  1257. END RemoveFileHeaderX;
  1258. PROCEDURE GetShortEntry(VAR entry: ARRAY OF CHAR; name: ARRAY OF CHAR; attr: SET; NTres: CHAR;
  1259. cluster, size, time, date, wTime, wDate, aDate: LONGINT);
  1260. VAR i, j: LONGINT;
  1261. BEGIN
  1262. FOR i := 0 TO 10 DO entry[i] := name[i] END;
  1263. entry[11] := CHR(SYSTEM.VAL(LONGINT, attr));
  1264. entry[12] := NTres;
  1265. IF (cluster = NotAssigned) THEN cluster := 0 END;
  1266. FATVolumes.PutUnsignedInteger(entry, 20, cluster DIV 10000H);
  1267. FATVolumes.PutUnsignedInteger(entry, 26, cluster MOD 10000H);
  1268. FATVolumes.PutLongint(entry, 28, size);
  1269. TimeOberon2FAT(time, i, j);
  1270. FATVolumes.PutUnsignedInteger(entry, 14, i); entry[13] := CHR(j);
  1271. FATVolumes.PutUnsignedInteger(entry, 16, DateOberon2FAT(date));
  1272. TimeOberon2FAT(wTime, i, j);
  1273. FATVolumes.PutUnsignedInteger(entry, 22, i);
  1274. FATVolumes.PutUnsignedInteger(entry, 24, DateOberon2FAT(wDate));
  1275. FATVolumes.PutUnsignedInteger(entry, 18, DateOberon2FAT(aDate))
  1276. END GetShortEntry;
  1277. PROCEDURE WriteFileHeader(f: File);
  1278. BEGIN {EXCLUSIVE} WriteFileHeaderX(f)
  1279. END WriteFileHeader;
  1280. PROCEDURE WriteFileHeaderX(f: File);
  1281. VAR data: ARRAY 32 OF CHAR; b, ro, writeLast: BOOLEAN;
  1282. ofs, i, k, len, numFree, s, ucs: LONGINT; unicode: ARRAY 256 OF INTEGER;
  1283. r: Files.Rider; c, chksum: CHAR;
  1284. BEGIN
  1285. IF (faReadOnly IN attr) THEN EXCL(attr, faReadOnly); ro := TRUE END;
  1286. IF f.modName THEN
  1287. len := NameLength(f.long);
  1288. (* delete old name *)
  1289. IF (len > f.entry.len) THEN ofs := NotAssigned (* new name is longer, find new position *)
  1290. ELSE ofs := f.entry.ofs (* reuse old position *)
  1291. END;
  1292. RemoveFileHeaderX(f);
  1293. f.entry.ofs := ofs;
  1294. f.entry.len := len;
  1295. f.registered := TRUE;
  1296. IF (f.entry.ofs = NotAssigned) THEN (* find 'len' subsequent free entries *)
  1297. ofs := firstFreePos;
  1298. IF (firstFreePos = MAX(LONGINT)) THEN ofs := 0 END;
  1299. ASSERT(ofs MOD 32 = 0);
  1300. numFree := 0;
  1301. WHILE ~r.eof & (numFree < len) DO
  1302. SetX(r, ofs); ReadX(r, c);
  1303. IF (c = deFree) THEN
  1304. IF (f.entry.ofs = NotAssigned) THEN f.entry.ofs := ofs END;
  1305. INC(numFree)
  1306. ELSIF (c = deLast) THEN
  1307. IF (f.entry.ofs = NotAssigned) THEN f.entry.ofs := ofs END;
  1308. numFree := len;
  1309. writeLast := TRUE
  1310. ELSE
  1311. f.entry.ofs := NotAssigned; numFree := 0
  1312. END;
  1313. INC(ofs, 32)
  1314. END;
  1315. IF (numFree < len) & ((len-numFree)*32 >= Length()) & ~extendable THEN HALT(ErrRootDirFull) END;
  1316. ASSERT(f.entry.ofs MOD 32 = 0);
  1317. END;
  1318. SetX(r, f.entry.ofs);
  1319. IF (len = 1) THEN
  1320. FOR i := 0 TO 10 DO f.short[i] := " " END;
  1321. i := 0;
  1322. WHILE (f.long[i] # 0X) & (f.long[i] # ".") DO f.short[i] := f.long[i]; INC(i) END;
  1323. IF (f.long[i] = ".") THEN
  1324. INC(i); k := 8;
  1325. WHILE (f.long[i] # 0X) DO f.short[k] := f.long[i]; INC(i); INC(k) END;
  1326. END
  1327. ELSE
  1328. GetShortName(f.long, f.short, chksum);
  1329. FOR i := 0 TO 255 DO unicode[i] := -1 END; (* = 0FFFFH *)
  1330. k := 0; i := 0;
  1331. REPEAT
  1332. b := UTF8Strings.DecodeChar(f.long, k, ucs);
  1333. IF ~b OR (ucs < 0) OR (ucs > MAX(INTEGER)) THEN HALT(ErrInvalidFilename) END;
  1334. unicode[i] := SHORT(ucs); INC(i)
  1335. UNTIL (ucs = 0);
  1336. WHILE (len > 1) DO
  1337. IF (len < f.entry.len) THEN data[0] := CHR(len-1) ELSE data[0] := CHR(40H + len-1) END;
  1338. data[11] := SYSTEM.VAL(CHAR, faLongName);
  1339. data[12] := 0X;
  1340. data[13] := chksum;
  1341. FATVolumes.PutUnsignedInteger(data, 26, 0);
  1342. ofs := (len-2)*13;
  1343. FOR k := 0 TO 4 DO FATVolumes.PutUnsignedInteger(data, 1+k*2, unicode[ofs+k]) END;
  1344. FOR k := 0 TO 5 DO FATVolumes.PutUnsignedInteger(data, 14+k*2, unicode[ofs+5+k]) END;
  1345. FOR k := 0 TO 1 DO FATVolumes.PutUnsignedInteger(data, 28+k*2, unicode[ofs+11+k]) END;
  1346. WriteBytesX(r, data, 0, 32);
  1347. IF (r.res # 0) THEN HALT(ErrIOError) END;
  1348. DEC(len)
  1349. END
  1350. END
  1351. ELSE
  1352. ASSERT((f.entry.ofs # NotAssigned) & (f.entry.len > 0));
  1353. SetX(r, f.entry.ofs + 32*(f.entry.len-1))
  1354. END;
  1355. (* create short entry *)
  1356. IF (faDirectory IN f.attr) THEN s := 0 ELSE s := f.Length() END;
  1357. GetShortEntry(data, f.short, f.attr, f.NTres, f.cluster, s, f.time, f.date, f.writeTime, f.writeDate, f.accessDate);
  1358. (* wp: Pos(r) = position of short entry *)
  1359. WriteBytesX(r, data, 0, 32);
  1360. IF writeLast & (Pos(r) < size) THEN WriteX(r, 0X) END;
  1361. UpdateX;
  1362. IF (size MOD clusterSize # 0) THEN
  1363. InitSize; ASSERT(size MOD clusterSize = 0)
  1364. END;
  1365. IF (r.res # 0) THEN HALT(ErrIOError) END;
  1366. f.modH := FALSE; f.modName := FALSE;
  1367. IF ro THEN INCL(attr, faReadOnly) END
  1368. END WriteFileHeaderX;
  1369. PROCEDURE NewSubdirectory(name: ARRAY OF CHAR; VAR res: WORD): Directory;
  1370. VAR upName: Filename; dir: Directory; f: File; i, t, d, p: LONGINT; r: Files.Rider; entry: ARRAY 32 OF CHAR;
  1371. BEGIN {EXCLUSIVE}
  1372. IF UTF8Strings.Valid(name) & ValidateName(name) THEN
  1373. UTF8Strings.UpperCase(name, upName);
  1374. f := FindX(upName);
  1375. IF (f = NIL) THEN
  1376. NEW(dir, fs);
  1377. COPY(name, dir.long); dir.attr := {faDirectory}; dir.NTres := 0X;
  1378. dir.cluster := fs.vol(FATVolumes.Volume).AllocCluster(EOC, res);
  1379. IF (res = Ok) THEN
  1380. fs.vol(FATVolumes.Volume).WriteFATEntry(dir.cluster, EOC, res);
  1381. ASSERT(res = Ok);
  1382. dir.parent := cluster;
  1383. Clock.Get(dir.time, dir.date);
  1384. dir.writeTime := dir.time; dir.writeDate := dir.date; dir.accessDate := dir.date;
  1385. dir.modH := TRUE; dir.modName := TRUE; dir.registered := TRUE;
  1386. dir.entry.len := NotAssigned; dir.entry.ofs := NotAssigned;
  1387. dir.size := 0; dir.key := 0;
  1388. WriteFileHeaderX(dir);
  1389. dir.Set(r, 0);
  1390. (* "."/".." entries *)
  1391. t := dir.time; d := dir.date;
  1392. IF (SELF IS RootDirectory) THEN p := 0 ELSE p := cluster END;
  1393. GetShortEntry(entry, ". ", {faDirectory}, 0X, dir.cluster, 0, t, d, t, d, t);
  1394. dir.WriteBytes(r, entry, 0, 32);
  1395. GetShortEntry(entry, ".. ", {faDirectory}, 0X, p, 0, t, d, t, d, t);
  1396. dir.WriteBytes(r, entry, 0, 32);
  1397. (* clear rest of directory cluster *)
  1398. FOR i := 0 TO 31 DO entry[i] := 0X END;
  1399. FOR i := 2 TO (dir.clusterSize DIV 32)-1 DO dir.WriteBytes(r, entry, 0, 32) END;
  1400. dir.Update;
  1401. res := r.res
  1402. ELSE dir := NIL (* res is already set *)
  1403. END
  1404. ELSE
  1405. res := ErrFileExists
  1406. END
  1407. ELSE
  1408. res := ErrInvalidFilename
  1409. END;
  1410. RETURN dir
  1411. END NewSubdirectory;
  1412. PROCEDURE DeleteCallback(f: File; par: Parameter): BOOLEAN;
  1413. BEGIN
  1414. WITH par: ResultParam DO
  1415. IF (f IS Directory) THEN
  1416. f(Directory).DeleteContents(par.res);
  1417. IF (par.res = Ok) THEN EXCL(f.attr, faReadOnly) END;
  1418. END;
  1419. IF (par.res = Ok) THEN
  1420. f.DeleteClusterChain(par.res) (* we don't need to remove the directory entry since the directory itself will be deleted *)
  1421. END;
  1422. RETURN (par.res = Ok)
  1423. END
  1424. END DeleteCallback;
  1425. PROCEDURE DeleteContents(VAR res: WORD);
  1426. VAR par: ResultParam; enum: FileEnumerator;
  1427. BEGIN {EXCLUSIVE}
  1428. NEW(enum, cluster);
  1429. fs(FileSystem).openFiles.Enumerate(enum.EnumFile);
  1430. IF (enum.count > 0) THEN res := ErrHasOpenFiles
  1431. ELSE
  1432. NEW(par); par.res := Ok;
  1433. EnumerateX(DeleteCallback, TRUE, par);
  1434. res := par.res
  1435. END
  1436. END DeleteContents;
  1437. PROCEDURE FindCallback(f: File; par: Parameter): BOOLEAN;
  1438. VAR name: Filename;
  1439. BEGIN
  1440. WITH par: NameParam DO
  1441. UTF8Strings.UpperCase(f.long, name);
  1442. IF (name = par.name) THEN
  1443. par.file := f;
  1444. RETURN FALSE
  1445. ELSE
  1446. RETURN TRUE
  1447. END
  1448. END
  1449. END FindCallback;
  1450. PROCEDURE Find(VAR filename: ARRAY OF CHAR): File;
  1451. BEGIN {EXCLUSIVE}
  1452. RETURN FindX(filename)
  1453. END Find;
  1454. PROCEDURE FindX(VAR filename: ARRAY OF CHAR): File;
  1455. VAR par: NameParam; f: File;
  1456. BEGIN
  1457. IF (filename # "") THEN
  1458. NEW(par); UTF8Strings.UpperCase(filename, par.name); par.file := NIL;
  1459. EnumerateX(FindCallback, TRUE, par);
  1460. f := par.file
  1461. END;
  1462. RETURN f
  1463. END FindX;
  1464. PROCEDURE FindByClusterCallback(f: File; par: Parameter): BOOLEAN;
  1465. BEGIN
  1466. WITH par: ClusterParam DO
  1467. IF (f.cluster = par.cluster) THEN par.file := f; RETURN FALSE
  1468. ELSE RETURN TRUE
  1469. END
  1470. END
  1471. END FindByClusterCallback;
  1472. PROCEDURE FindByCluster(cluster: Address): File;
  1473. VAR par: ClusterParam;
  1474. BEGIN {EXCLUSIVE}
  1475. NEW(par); par.cluster := cluster; par.file := NIL;
  1476. EnumerateX(FindByClusterCallback, TRUE, par);
  1477. RETURN par.file
  1478. END FindByCluster;
  1479. END Directory;
  1480. RootDirectory = OBJECT(Directory)
  1481. PROCEDURE GetFullName*(VAR name: ARRAY OF CHAR; WithPrefix: BOOLEAN);
  1482. VAR pos, i: LONGINT;
  1483. BEGIN {EXCLUSIVE}
  1484. pos := 0; i := 0;
  1485. IF WithPrefix THEN
  1486. WHILE (fs.prefix[i] # 0X) & (pos < LEN(name)) DO
  1487. name[pos] := fs.prefix[i];
  1488. INC(pos); INC(i)
  1489. END;
  1490. name[pos] := ":"; INC(pos)
  1491. END;
  1492. IF (pos < LEN(name)-1) THEN
  1493. name[pos] := PathDelimiter; INC(pos)
  1494. END;
  1495. name[MIN(LEN(name)-1, pos)] := 0X
  1496. END GetFullName;
  1497. END RootDirectory;
  1498. RootDirectory1216 = OBJECT(RootDirectory) (* for FAT12/FAT16 file systems *)
  1499. PROCEDURE &Init*(fs: Files.FileSystem);
  1500. BEGIN
  1501. Init^(fs);
  1502. clusterSize := FATVolumes.BS;
  1503. extendable := FALSE
  1504. END Init;
  1505. PROCEDURE InitSize;
  1506. BEGIN
  1507. size := fs.vol(FATVolumes.FAT1216Volume).numRootSectors*FATVolumes.BS
  1508. END InitSize;
  1509. PROCEDURE ReadBuffer(buffer: Buffer; pos: LONGINT);
  1510. VAR vol: FATVolumes.FAT1216Volume; res: WORD;
  1511. BEGIN
  1512. vol := fs.vol(FATVolumes.FAT1216Volume);
  1513. IF (pos < 0) OR (pos >= vol.numRootSectors) THEN HALT(ErrInvalidParams) END;
  1514. buffer.cluster := pos; buffer.pos := pos; ASSERT(LEN(buffer.data) = clusterSize);
  1515. vol.ReadSector(vol.firstRootSector + pos, buffer.data^, res);
  1516. IF (res # Ok) THEN HALT(ErrIOError) END
  1517. END ReadBuffer;
  1518. PROCEDURE WriteBuffer(buffer: Buffer);
  1519. VAR vol: FATVolumes.FAT1216Volume; res: WORD;
  1520. BEGIN
  1521. vol := fs.vol(FATVolumes.FAT1216Volume);
  1522. IF (buffer.cluster < 0) OR (buffer.cluster >= vol.numRootSectors) THEN HALT(ErrInvalidParams) END;
  1523. vol.WriteSector(vol.firstRootSector + buffer.cluster, buffer.data^, res);
  1524. IF (res # Ok) THEN HALT(ErrIOError) END
  1525. END WriteBuffer;
  1526. END RootDirectory1216;
  1527. RootDirectory32 = OBJECT(RootDirectory) (* for FAT32 file systems *)
  1528. END RootDirectory32;
  1529. (** Generate a new file system object. Files.NewVol has volume parameter, Files.Par has mount prefix. *)
  1530. PROCEDURE NewFS*(context : Files.Parameters);
  1531. VAR fs: FileSystem; rootDirName : ARRAY 32 OF CHAR;
  1532. BEGIN
  1533. IF (Files.This(context.prefix) = NIL) THEN
  1534. NEW(fs);
  1535. fs.vol := context.vol;
  1536. IF (fs.vol IS FATVolumes.FAT12Volume) THEN fs.desc := "FAT 12"
  1537. ELSIF (fs.vol IS FATVolumes.FAT16Volume) THEN fs.desc := "FAT 16"
  1538. ELSIF (fs.vol IS FATVolumes.FAT32Volume) THEN fs.desc := "FAT 32"
  1539. ELSE
  1540. context.error.String("FATFiles.NewFS: wrong volume type"); context.error.Ln;
  1541. RETURN;
  1542. END;
  1543. fs.Initialize;
  1544. IF context.arg.GetString(rootDirName) THEN
  1545. IF ~fs.SetRootDirectory(rootDirName) THEN
  1546. context.error.String("Warning: root directory not found"); context.error.Ln;
  1547. END;
  1548. END;
  1549. Files.Add(fs, context.prefix)
  1550. ELSE
  1551. context.error.String(moduleName); context.error.String(context.prefix); context.error.String(" already in use"); context.error.Ln;
  1552. END;
  1553. END NewFS;
  1554. PROCEDURE PurgeFile(f: ANY);
  1555. VAR res: WORD;
  1556. BEGIN
  1557. WITH f: File DO
  1558. IF ~f.registered & (f.cluster # NotAssigned) THEN
  1559. f.DeleteClusterChain(res) (* ignore res *)
  1560. END
  1561. END
  1562. END PurgeFile;
  1563. (* ValidateName - checks if 'name' is a valid long name and removes leading spaces and trailing spaces and periods *)
  1564. PROCEDURE ValidateName(VAR name: ARRAY OF CHAR): BOOLEAN;
  1565. VAR s: POINTER TO ARRAY OF CHAR; np, sp: LONGINT;
  1566. BEGIN
  1567. NEW(s, LEN(name));
  1568. COPY(name, s^);
  1569. sp := 0; np := 0;
  1570. WHILE (s[sp] = " ") DO INC(sp) END; (* ignore leading spaces *)
  1571. WHILE (s[sp] # 0X) DO
  1572. IF ~ValidLongChar(s[sp]) THEN RETURN FALSE END;
  1573. name[np] := s[sp];
  1574. INC(np); INC(sp)
  1575. END;
  1576. WHILE (np > 0) & ((name[np-1] = ".") OR (name[np-1] = " ")) DO DEC(np) END; (* ignore trailing spaces or periods *)
  1577. name[np] := 0X;
  1578. RETURN (np > 0) & (UTF8Strings.Length(name) <= 255)
  1579. END ValidateName;
  1580. PROCEDURE ValidLongChar*(ch: CHAR): BOOLEAN;
  1581. BEGIN
  1582. RETURN (ch >= 20X) & (ch # "\") & (ch # "/") & (ch # ":") & (ch # "*") & (ch # "?") & (ch # '"') & (ch # "<") & (ch # ">") & (ch # "|")
  1583. END ValidLongChar;
  1584. (* ValidShortChar - checks if a char 'ch' in a short name is valid *)
  1585. PROCEDURE ValidShortChar*(ch: CHAR): BOOLEAN;
  1586. BEGIN
  1587. RETURN (("0" <= ch) & (ch <= "9")) OR (("A" <= ch) & (ch <= "Z")) OR
  1588. (ch = "$" ) OR (ch = "%") OR (ch = "'") OR (ch = "-") OR (ch = "_") OR (ch = "@") OR (ch = "~") OR (ch = "`") OR
  1589. (ch = "!") OR (ch = "(") OR (ch = ")") OR (ch = "{") OR (ch = "}") OR (ch = "^") OR (ch = "#") OR (ch = "&") OR (ch = " ")
  1590. END ValidShortChar;
  1591. (* IsShortName - checks if a long name 'fn' can be stored in one "short" directory entry *)
  1592. PROCEDURE IsShortName(CONST fn: Filename): BOOLEAN;
  1593. VAR s: ARRAY 12 OF CHAR; i, k: INTEGER;
  1594. BEGIN
  1595. IF (fn = ".") OR (fn = "..") THEN RETURN TRUE
  1596. ELSIF (UTF8Strings.UTF8toASCII(fn, 0X, s) = 0) THEN
  1597. i := 0;
  1598. WHILE (i < 11) & (s[i] # 0X) & ValidShortChar(s[i]) DO INC(i) END;
  1599. IF (s[i] = ".") & (i < 8) THEN
  1600. INC(i); k := i;
  1601. WHILE (i < 11) & ValidShortChar(s[i]) DO INC(i) END;
  1602. RETURN (s[i] = 0X) & (i - k <= 3)
  1603. ELSE RETURN (s[i] = 0X)
  1604. END
  1605. END;
  1606. RETURN FALSE
  1607. END IsShortName;
  1608. PROCEDURE CheckSum*(short: Shortname): CHAR;
  1609. VAR chksum, i: LONGINT;
  1610. BEGIN
  1611. chksum := 0;
  1612. FOR i := 0 TO 10 DO
  1613. IF ODD(chksum) THEN chksum := 80H + chksum DIV 2 ELSE chksum := chksum DIV 2 END;
  1614. chksum := (chksum + ORD(short[i])) MOD 100H
  1615. END;
  1616. RETURN CHR(chksum)
  1617. END CheckSum;
  1618. (* NameLength - returns the number of directory entries needed to store a file with filename 'fn' *)
  1619. PROCEDURE NameLength(CONST fn: Filename): LONGINT;
  1620. VAR pos, ucs, i: LONGINT;
  1621. BEGIN
  1622. IF IsShortName(fn) THEN RETURN 1
  1623. ELSE
  1624. WHILE UTF8Strings.DecodeChar(fn, pos, ucs) & (ucs # 0) DO INC(i) END;
  1625. RETURN (i + 12) DIV 13 + 1 (* 13 characters per long entry plus 1 short entry *)
  1626. END
  1627. END NameLength;
  1628. (* UpperCh - extended CAP function that also works for special characters. lossy=TRUE indicates a lossy conversion (e.g. â->A) *)
  1629. PROCEDURE UpperCh(ch: CHAR; VAR lossy: BOOLEAN): CHAR;
  1630. BEGIN
  1631. lossy := TRUE;
  1632. CASE ch OF
  1633. "A".."Z" : lossy := FALSE |
  1634. "a" .. "z": ch := CAP(ch); lossy := FALSE |
  1635. "0".."9", "$", "%", "'", "-", "_", "@", "~", "`", "!", "(", ")", "{", "}", "^", "#", "&", ".", ",": lossy := FALSE (* |
  1636. "ä": ch := "Ä"; lossy := FALSE |
  1637. "ö": ch := "Ö"; lossy := FALSE |
  1638. "ü": ch := "Ü"; lossy := FALSE |
  1639. "â": ch := "A" |
  1640. "ê": ch := "E" |
  1641. "î": ch := "I" |
  1642. "ô": ch := "O" |
  1643. "û": ch := "U" |
  1644. "à": ch := "A" |
  1645. "è": ch := "E" |
  1646. "ì": ch := "I" |
  1647. "ò": ch := "O" |
  1648. "ù": ch := "U" |
  1649. "é": ch := "E" |
  1650. "ë": ch := "E" |
  1651. "ï": ch := "I" |
  1652. "ç": ch := "C" |
  1653. "á": ch := "A" |
  1654. "ñ": ch := "N" |
  1655. "ß": ch := "S" *)
  1656. ELSE
  1657. END;
  1658. RETURN ch
  1659. END UpperCh;
  1660. (** DateFAT2Oberon, DateOberon2FAT, TimeFAT2Oberon, TimeOberon2FAT - conversion between FAT and
  1661. Oberon date/time values *)
  1662. (* DOS formats:
  1663. date: bits 15-9: count of years from 1980 (0-127)
  1664. 8-5: month of year (1-12)
  1665. 4-0: day of month (1-31)
  1666. time: bits 15-11: hours (0-23)
  1667. 10-5: minutes (0-59)
  1668. 4-0: 2-second count (0-29)
  1669. additional byte: bits 7-8: count of 0.01 seconds (0-199)
  1670. Oberon formats:
  1671. time: bits 16-12: hours
  1672. 11-6: minutes
  1673. 5-0: seconds
  1674. date: 30-9: count of years from 1900
  1675. 8-5: month of year
  1676. 4-0: day of month
  1677. *)
  1678. PROCEDURE DateFAT2Oberon*(d: LONGINT): LONGINT;
  1679. BEGIN RETURN (d DIV 512 MOD 128 + 80) * 512 + d MOD 512
  1680. END DateFAT2Oberon;
  1681. PROCEDURE DateOberon2FAT*(d: LONGINT): LONGINT;
  1682. BEGIN RETURN (d DIV 512 - 80) MOD 128 * 512 + d MOD 512
  1683. END DateOberon2FAT;
  1684. PROCEDURE TimeFAT2Oberon*(time, tenth: LONGINT): LONGINT;
  1685. BEGIN RETURN time DIV 2048 MOD 32 * 4096 + time DIV 32 MOD 64 * 64 + time MOD 32 * 2 + tenth DIV 100
  1686. END TimeFAT2Oberon;
  1687. PROCEDURE TimeOberon2FAT*(t: LONGINT; VAR time, tenth: LONGINT);
  1688. BEGIN
  1689. time := t DIV 4096 MOD 32 * 2048 + t DIV 64 MOD 64 * 32 + t MOD 64 DIV 2;
  1690. tenth := 100 * SHORT(FATVolumes.AND(t, 1) MOD 200)
  1691. END TimeOberon2FAT;
  1692. (* Clean up when module unloaded. *)
  1693. PROCEDURE Finalization;
  1694. VAR ft: Files.FileSystemTable; i: LONGINT;
  1695. BEGIN
  1696. IF Modules.shutdown = Modules.None THEN
  1697. Files.GetList(ft);
  1698. IF ft # NIL THEN
  1699. FOR i := 0 TO LEN(ft^)-1 DO
  1700. IF ft[i] IS FileSystem THEN Files.Remove(ft[i]) END
  1701. END
  1702. END
  1703. END
  1704. END Finalization;
  1705. BEGIN
  1706. IF (NotAssigned # -1) THEN HALT(ErrInvalidParams) END;
  1707. Modules.InstallTermHandler(Finalization)
  1708. END FATFiles.
  1709. (* Notes:
  1710. Methods with {} notation are explicitly unprotected. They must be called only from a protected context.
  1711. *)