Merge pull request #6 from djs55/tidy-up

Resync BLOCK_DEVICE with mirage-types V1

CHANGES

@@ -0,0 +1,2 @@
+0.5.0 (2-Dec-2013)
+* Initial version of fat-filesystem

_oasis

@@ -1,5 +1,5 @@
 OASISFormat: 0.3
-Name:        fat-format
+Name:        fat-filesystem
 Version:     0.5.0
 Synopsis:    FAT filesystem manipulation
 Authors:     David Scott
@@ -11,33 +11,25 @@ Library fat
   Pack:               true
   CompiledObject:     best
   Path:               lib
-  Findlibname:        fat-format
+  Findlibname:        fat-filesystem
   Modules:            Fat_format, Boot_sector, Entry, Name, Path, Fs, Update, SectorMap, Result, MemoryIO, S
-  BuildDepends:       cstruct, re, re.str
-
-Library fat_lwt
-  CompiledObject:     best
-  Path:               lib
-  Findlibname:        lwt
-  Findlibparent:      fat
-  Modules:            Block_device_lwt_unix
-  BuildDepends:       lwt, lwt.unix, cstruct.lwt
+  BuildDepends:       cstruct, re, re.str, mirage-types, lwt
 
 Executable shell
   CompiledObject:     best
   Path:               shell
   MainIs:             main.ml
   Custom:             true
   Install:            false
-  BuildDepends:       fat-format, fat-format.lwt
+  BuildDepends:       fat-filesystem, mirage-block
 
 Executable test
   CompiledObject:     best
   Path:               lib_test
   MainIs:             test.ml
   Custom:             true
   Install:            false
-  BuildDepends:       lwt, lwt.unix, fat-format, fat-format.lwt, cstruct, oUnit
+  BuildDepends:       lwt, lwt.unix, fat-filesystem, cstruct, oUnit, mirage-block
 
 Test test
   Command:            ./test.native

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 2253ed07c120cc97364f0c33b7bec326)
+# DO NOT EDIT (digest: 3a2251f984c1f8d6e73f9adee71e5b9d)
 # Ignore VCS directories, you can use the same kind of rule outside 
 # OASIS_START/STOP if you want to exclude directories that contains 
 # useless stuff for the build process
@@ -26,51 +26,46 @@
 "lib/result.cmx": for-pack(Fat)
 "lib/memoryIO.cmx": for-pack(Fat)
 "lib/s.cmx": for-pack(Fat)
+<lib/*.ml{,i}>: pkg_lwt
 <lib/*.ml{,i}>: pkg_cstruct
 <lib/*.ml{,i}>: pkg_re
 <lib/*.ml{,i}>: pkg_re.str
-# Library fat_lwt
-"lib/fat_lwt.cmxs": use_fat_lwt
-<lib/*.ml{,i}>: pkg_lwt
-<lib/*.ml{,i}>: pkg_lwt.unix
-<lib/*.ml{,i}>: pkg_cstruct.lwt
+<lib/*.ml{,i}>: pkg_mirage-types
 # Executable shell
 <shell/main.{native,byte}>: use_fat
-<shell/main.{native,byte}>: use_fat_lwt
 <shell/main.{native,byte}>: pkg_lwt
-<shell/main.{native,byte}>: pkg_lwt.unix
 <shell/main.{native,byte}>: pkg_cstruct
-<shell/main.{native,byte}>: pkg_cstruct.lwt
+<shell/main.{native,byte}>: pkg_mirage-block
 <shell/main.{native,byte}>: pkg_re
 <shell/main.{native,byte}>: pkg_re.str
+<shell/main.{native,byte}>: pkg_mirage-types
 <shell/*.ml{,i}>: use_fat
-<shell/*.ml{,i}>: use_fat_lwt
 <shell/*.ml{,i}>: pkg_lwt
-<shell/*.ml{,i}>: pkg_lwt.unix
 <shell/*.ml{,i}>: pkg_cstruct
-<shell/*.ml{,i}>: pkg_cstruct.lwt
+<shell/*.ml{,i}>: pkg_mirage-block
 <shell/*.ml{,i}>: pkg_re
 <shell/*.ml{,i}>: pkg_re.str
+<shell/*.ml{,i}>: pkg_mirage-types
 <shell/main.{native,byte}>: custom
 # Executable test
 <lib_test/test.{native,byte}>: use_fat
-<lib_test/test.{native,byte}>: use_fat_lwt
 <lib_test/test.{native,byte}>: pkg_lwt
 <lib_test/test.{native,byte}>: pkg_lwt.unix
 <lib_test/test.{native,byte}>: pkg_cstruct
 <lib_test/test.{native,byte}>: pkg_oUnit
-<lib_test/test.{native,byte}>: pkg_cstruct.lwt
+<lib_test/test.{native,byte}>: pkg_mirage-block
 <lib_test/test.{native,byte}>: pkg_re
 <lib_test/test.{native,byte}>: pkg_re.str
+<lib_test/test.{native,byte}>: pkg_mirage-types
 <lib_test/*.ml{,i}>: use_fat
-<lib_test/*.ml{,i}>: use_fat_lwt
 <lib_test/*.ml{,i}>: pkg_lwt
 <lib_test/*.ml{,i}>: pkg_lwt.unix
 <lib_test/*.ml{,i}>: pkg_cstruct
 <lib_test/*.ml{,i}>: pkg_oUnit
-<lib_test/*.ml{,i}>: pkg_cstruct.lwt
+<lib_test/*.ml{,i}>: pkg_mirage-block
 <lib_test/*.ml{,i}>: pkg_re
 <lib_test/*.ml{,i}>: pkg_re.str
+<lib_test/*.ml{,i}>: pkg_mirage-types
 <lib_test/test.{native,byte}>: custom
 # OASIS_STOP
 <lib/boot_sector.ml>: syntax_camlp4o, pkg_cstruct.syntax

lib/META

@@ -1,22 +1,12 @@
 # OASIS_START
-# DO NOT EDIT (digest: b7f8a88322d9704c4bca3ea139b15a89)
+# DO NOT EDIT (digest: 2f64d454147da10129fc59a0ba52dc2c)
 version = "0.5.0"
 description = "FAT filesystem manipulation"
-requires = "cstruct re re.str"
+requires = "cstruct re re.str mirage-types lwt"
 archive(byte) = "fat.cma"
 archive(byte, plugin) = "fat.cma"
 archive(native) = "fat.cmxa"
 archive(native, plugin) = "fat.cmxs"
 exists_if = "fat.cma"
-package "lwt" (
- version = "0.5.0"
- description = "FAT filesystem manipulation"
- requires = "lwt lwt.unix cstruct.lwt"
- archive(byte) = "fat_lwt.cma"
- archive(byte, plugin) = "fat_lwt.cma"
- archive(native) = "fat_lwt.cmxa"
- archive(native, plugin) = "fat_lwt.cmxs"
- exists_if = "fat_lwt.cma"
-)
 # OASIS_STOP
 

lib/entry.ml

@@ -104,27 +104,6 @@ let make boot_sector format =
   done;
   buf
 
-
-module IntSet = Set.Make(struct type t = int let compare = compare end)
-
-(** [follow_chain format fat cluster] returns the list of sectors containing
-    data according to FAT [fat] which is of type [format]. *)
-let follow_chain format fat cluster =
-  (* the elements will be returned in order as 'list'; 'set' is used to
-     check that we aren't going round in an infinite loop. *)
-  let rec inner (list, set) = function
-    | 0 -> list (* either zero-length chain if list = [] or corrupt file *)
-    | 1 -> list (* corrupt file *)
-    | i -> begin match unmarshal format i fat with
-      | End -> i :: list
-      | Free | Bad -> list (* corrupt file *)
-      | Used j ->
-        if IntSet.mem i set
-        then list (* infinite loop: corrupt file *)
-        else inner (i :: list, IntSet.add i set) j
-      end in
-  List.rev (inner ([], IntSet.empty) cluster)
-
 let initial = 2 (* first valid entry *)
 
 (** [find_free_from boot format fat start] returns an unallocated cluster
@@ -138,30 +117,55 @@ let find_free_from boot format fat start =
     | _ -> inner (i + 1) in
   inner start
 
-(** [extend boot format fat last n] allocates [n] free clusters to extend
-    the chain whose current end is [last] *)
-let extend boot format fat (last: int option) n =
-  let rec inner acc start = function
-    | 0 -> acc (* in reverse disk order *)
-    | i ->
-      match find_free_from boot format fat start with
-      | None -> acc (* out of space *)
-      | Some c -> inner (c :: acc) (c + 1) (i - 1) in
-  let to_allocate = inner [] (match last with None -> initial | Some x -> x) n in
-  if n = 0
-  then []
-  else
-    if List.length to_allocate <> n
-    then [] (* allocation failed *)
+module Chain = struct
+  module IntSet = Set.Make(struct type t = int let compare = compare end)
+
+  type t = int list
+
+  let follow format fat cluster =
+    (* the elements will be returned in order as 'list'; 'set' is used to
+       check that we aren't going round in an infinite loop. *)
+    let rec inner (list, set) = function
+      | 0 -> list (* either zero-length chain if list = [] or corrupt file *)
+      | 1 -> list (* corrupt file *)
+      | i -> begin match unmarshal format i fat with
+        | End -> i :: list
+        | Free | Bad -> list (* corrupt file *)
+        | Used j ->
+          if IntSet.mem i set
+          then list (* infinite loop: corrupt file *)
+          else inner (i :: list, IntSet.add i set) j
+        end in
+    List.rev (inner ([], IntSet.empty) cluster)
+
+  (** [extend boot format fat last n] allocates [n] free clusters to extend
+      the chain whose current end is [last] *)
+  let extend boot format fat (last: int option) n =
+    let rec inner acc start = function
+      | 0 -> acc (* in reverse disk order *)
+      | i ->
+        match find_free_from boot format fat start with
+        | None -> acc (* out of space *)
+        | Some c -> inner (c :: acc) (c + 1) (i - 1) in
+    let to_allocate = inner [] (match last with None -> initial | Some x -> x) n in
+    if n = 0
+    then []
     else
-      let final = List.hd to_allocate in
-      let to_allocate = List.rev to_allocate in
-      ignore(List.fold_left (fun last next ->
-        (match last with
-         | Some last ->
-            marshal format last fat (Used next)
-         | None -> ());
-        Some next
-      ) last to_allocate);
-      marshal format final fat End;
-      to_allocate
+      if List.length to_allocate <> n
+      then [] (* allocation failed *)
+      else
+        let final = List.hd to_allocate in
+        let to_allocate = List.rev to_allocate in
+        ignore(List.fold_left (fun last next ->
+          (match last with
+           | Some last ->
+              marshal format last fat (Used next)
+           | None -> ());
+          Some next
+        ) last to_allocate);
+        marshal format final fat End;
+        to_allocate
+
+  let to_sectors boot clusters =
+    List.concat (List.map (Boot_sector.sectors_of_cluster boot) clusters)
+end