Merge #90 and rebase and merge #93

bin/impl.ml

@@ -35,9 +35,7 @@ let rec iter_s f = function
     | Error e -> Lwt.return (Error e)
     | Ok () -> iter_s f xs
 
-let alloc bytes =
-  let pages = Io_page.(to_cstruct (get ((bytes + 4095) / 4096))) in
-  Cstruct.sub pages 0 bytes
+let alloc bytes = Cstruct.create bytes
 
 let with_file flags filename f =
   Lwt_unix.openfile filename flags 0o0 >>= fun file ->

bin/shell.ml

@@ -159,10 +159,15 @@ let main filename _create_size =
     inner (snd(parse_path x))
   in
 
-  let space = Re.Str.regexp_string " " in
+  let split_ws s =
+    let non_empty_hd = function "" :: tl -> tl | tl -> tl in
+    let a = non_empty_hd (String.split_on_char ' ' s) in
+    List.rev (non_empty_hd (List.rev a))
+  in
+
   let rec loop () =
     Printf.printf "A:%s> %!" (Path.to_string !cwd);
-    match Re.Str.split space (input_line stdin) with
+    match split_ws (input_line stdin) with
     | [ "dir" ] -> do_dir "" >>= loop
     | [ "dir"; path ] -> do_dir path >>= loop
     | [ "cd"; path ] -> do_cd path >>= loop

fat-filesystem.opam

@@ -7,20 +7,16 @@ doc: "https://mirage.github.io/ocaml-fat/"
 bug-reports: "https://github.com/mirage/ocaml-fat/issues"
 license: "ISC"
 depends: [
-  "ocaml" {>= "4.06.0"}
+  "ocaml" {>= "4.08.0"}
   "dune" {>= "1.0"}
   "cstruct" {>= "6.0.0"}
   "ppx_cstruct"
-  "rresult"
   "lwt" {>= "2.4.3"}
   "mirage-block" {>= "3.0.0"}
   "mirage-block-unix" {>= "2.13.0"}
-  "mirage-kv" {>= "4.0.0"}
+  "mirage-kv" {>= "5.0.0"}
   "mirage-block-combinators" {with-test}
-  "io-page" {>= "2.4.0"}
-  "re" {>= "1.7.2"}
   "cmdliner" {>= "1.1.0"}
-  "astring"
   "fmt" {>= "0.8.7"}
   "alcotest" {with-test}
 ]

src/dune

@@ -1,8 +1,7 @@
 (library
  (name fat_filesystem)
  (public_name fat-filesystem)
- (libraries cstruct re re.str mirage-block mirage-kv lwt io-page
-   rresult astring)
+ (libraries cstruct mirage-block mirage-kv lwt)
  (wrapped false)
  (preprocess
   (pps ppx_cstruct)))

src/fat.ml

@@ -81,9 +81,7 @@ module Make (B: Mirage_block.S) = struct
   let (>>*=) x f = x >>= function Ok m -> f m | Error e -> Lwt.return @@ Error e
   let (>|*=) x f = x >|= function Ok m -> f m | Error e -> Error e
 
-  let alloc bytes =
-    let pages = Io_page.get_buf ~n:((bytes + 4095) / 4096) () in
-    Cstruct.sub pages 0 bytes
+  let alloc bytes = Cstruct.create bytes
 
   (* TODO: this function performs extra data copies *)
   let read_sectors bps device xs =
@@ -140,9 +138,9 @@ module Make (B: Mirage_block.S) = struct
         ~sectors_per_block ~bps page
 
   let make size =
-    let open Rresult in
+    let ( let* ) = Result.bind in
     let boot = Fat_boot_sector.make size in
-    Fat_boot_sector.detect_format boot >>= fun format ->
+    let* format = Fat_boot_sector.detect_format boot in
     let fat = Fat_entry.make boot format in
     let root_sectors = Fat_boot_sector.sectors_of_root_dir boot in
     let root = alloc (List.length root_sectors * 512) in
@@ -540,6 +538,31 @@ module KV_RO(B: Mirage_block.S) = struct
       | Error e -> Error (`FS e)
       | Ok l -> Ok Cstruct.(to_string (concat l))
 
+  let get_partial t key ~offset ~length =
+    let name = Mirage_kv.Key.to_string key in
+    FS.stat t name >>= function
+    | Error `Is_a_directory -> Lwt.return (Error (`Value_expected key))
+    | Error `No_directory_entry -> Lwt.return (Error (`Not_found key))
+    | Error e -> Lwt.return (Error (`FS e))
+    | Ok s ->
+      let file_size = Int64.to_int s.size in
+      let start_offset = Optint.Int63.to_int offset in
+      let actual_length = min length (file_size - start_offset) in
+      if start_offset > file_size then
+        Lwt.return (Ok "")
+      else
+        FS.read t name start_offset actual_length >|= function
+        | Error e -> Error (`FS e)
+        | Ok l -> Ok Cstruct.(to_string (concat l))
+
+  let size t key =
+    let name = Mirage_kv.Key.to_string key in
+    FS.stat t name >>= function
+    | Error `Is_a_directory -> Lwt.return (Error (`Value_expected key))
+    | Error `No_directory_entry -> Lwt.return (Error (`Not_found key))
+    | Error e -> Lwt.return (Error (`FS e))
+    | Ok s -> Lwt.return (Ok (Optint.Int63.of_int64 s.size))
+
   let list t key =
     let name = Mirage_kv.Key.to_string key in
     let dict_or_value fn =
@@ -557,10 +580,16 @@ module KV_RO(B: Mirage_block.S) = struct
           | Error e -> Lwt.return (Error e)
           | Ok acc -> dict_or_value f >|= function
             | Error e -> Error e
-            | Ok t -> Ok ((f, t) :: acc))
+            | Ok t -> Ok ((Mirage_kv.Key.add key f, t) :: acc))
         (Ok []) files
 
-  let last_modified _ _ = Lwt.return (Ok (0, 0L))
+  let last_modified t key =
+    let name = Mirage_kv.Key.to_string key in
+    FS.stat t name >>= function
+    | Error `Is_a_directory -> Lwt.return (Error (`Value_expected key))
+    | Error `No_directory_entry -> Lwt.return (Error (`Not_found key))
+    | Error e -> Lwt.return (Error (`FS e))
+    | Ok _s -> Lwt.return (Ok (Ptime.epoch))
 
   let digest t key =
     get t key >|= function

src/fat_boot_sector.ml

@@ -80,14 +80,18 @@ let marshal (buf: Cstruct.t) t =
   set_t_signature buf 0xaa55
 
 let unmarshal (buf: Cstruct.t) : (t, string) result =
-  let open Rresult in
-  ( if Cstruct.length buf < sizeof
+  let ( let* ) = Result.bind in
+  let* () =
+    if Cstruct.length buf < sizeof
     then Error (Printf.sprintf "boot sector too small: %d < %d" (Cstruct.length buf) sizeof)
-    else Ok () ) >>= fun () ->
+    else Ok ()
+  in
   let signature = get_t_signature buf in
-  ( if signature <> 0xaa55
+  let* () =
+    if signature <> 0xaa55
     then Error (Printf.sprintf "boot sector signature invalid: %04x <> %04x" signature 0xaa55)
-    else Ok () ) >>= fun () ->
+    else Ok ()
+  in
   let oem_name = Cstruct.to_string (get_t_oem_name buf) in
   let bytes_per_sector = get_t_bytes_per_sector buf in
   let sectors_per_cluster = get_t_sectors_per_cluster buf in

src/fat_name.ml

@@ -124,10 +124,14 @@ let legal_dos_string x =
     true
   with Not_found -> false
 
-let dot = Re.Str.regexp_string "."
+let split_dot s =
+  let non_empty_hd = function "" :: tl -> tl | tl -> tl in
+  let a = non_empty_hd (String.split_on_char '.' s) in
+  List.rev (non_empty_hd (List.rev a))
+
 let is_legal_dos_name filename =
   if (is_dot filename || is_dotdot filename) then true else
-  match Re.Str.split dot filename with
+  match split_dot filename with
   | [ one ] -> String.length one <= 8 && (legal_dos_string one)
   | [ one; two ] -> String.length one <= 8
                     && (String.length two <= 3)
@@ -142,17 +146,15 @@ let add_padding p n x =
     Bytes.blit_string x 0 y 0 (String.length x);
     Bytes.unsafe_to_string y
 
-let uppercase = Astring.String.Ascii.uppercase
-
 let dos_name_of_filename filename =
   if (is_dot filename || is_dotdot filename) then filename, "" else
   if is_legal_dos_name filename
-  then match Re.Str.split dot filename with
+  then match split_dot filename with
     | [ one ] -> add_padding ' ' 8 one, "   "
     | [ one; two ] -> add_padding ' ' 8 one, add_padding ' ' 3 two
     | _ -> assert false (* implied by is_legal_dos_name *)
   else
-    let all  = uppercase (Digest.to_hex (Digest.string filename)) in
+    let all  = String.uppercase_ascii Digest.(to_hex (string filename)) in
     let base = String.sub all 0 8 in
     let ext  = String.sub all 8 3 in
     base, ext

src/fat_path.ml

@@ -23,9 +23,12 @@ let filename = List.hd
 
 let to_string p = "/" ^ (String.concat "/" (to_string_list p))
 
-let slash = Re.Str.regexp_string "/"
+let split s =
+  let non_empty_hd = function "" :: tl -> tl | tl -> tl in
+  let a = non_empty_hd (String.split_on_char '/' s) in
+  List.rev (non_empty_hd (List.rev a))
 
-let of_string s = if s = "/" || s = "" then [] else of_string_list (Re.Str.split slash s)
+let of_string s = if s = "/" || s = "" then [] else of_string_list (split s)
 
 let concat path x = x :: path
 

test/test.ml

@@ -25,9 +25,7 @@ let (>>*=) m f = m >>= function
   | Error e -> fail "%a" MemFS.pp_write_error (e :> MemFS.write_error)
   | Ok x    -> f x
 
-let alloc bytes =
-  let pages = Io_page.(to_cstruct (get ((bytes + 4095) / 4096))) in
-  Cstruct.sub pages 0 bytes
+let alloc bytes = Cstruct.create bytes
 
 let read_sector filename =
   Lwt_unix.openfile filename [ Lwt_unix.O_RDONLY ] 0o0 >>= fun fd ->