From 357b3fd07b87e66ec4dfe1f1301045abed3ebfad Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Fri, 23 Sep 2022 15:35:14 +0200 Subject: [PATCH 1/6] remove astring dependency --- fat-filesystem.opam | 1 - src/dune | 2 +- src/fat_name.ml | 4 +--- 3 files changed, 2 insertions(+), 5 deletions(-) diff --git a/fat-filesystem.opam b/fat-filesystem.opam index d6ec063..9d8333a 100644 --- a/fat-filesystem.opam +++ b/fat-filesystem.opam @@ -20,7 +20,6 @@ depends: [ "io-page" {>= "2.4.0"} "re" {>= "1.7.2"} "cmdliner" {>= "1.1.0"} - "astring" "fmt" {>= "0.8.7"} "alcotest" {with-test} ] diff --git a/src/dune b/src/dune index c991815..0a6b8e9 100644 --- a/src/dune +++ b/src/dune @@ -2,7 +2,7 @@ (name fat_filesystem) (public_name fat-filesystem) (libraries cstruct re re.str mirage-block mirage-kv lwt io-page - rresult astring) + rresult) (wrapped false) (preprocess (pps ppx_cstruct))) diff --git a/src/fat_name.ml b/src/fat_name.ml index 7700cc7..4b73709 100644 --- a/src/fat_name.ml +++ b/src/fat_name.ml @@ -142,8 +142,6 @@ 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 @@ -152,7 +150,7 @@ let dos_name_of_filename filename = | [ 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 From 8b727aa55ed5eab8775f217f479d2e14bc4d4428 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Fri, 23 Sep 2022 15:37:11 +0200 Subject: [PATCH 2/6] remove rresult dependency, require OCaml 4.08 --- fat-filesystem.opam | 3 +-- src/dune | 3 +-- src/fat.ml | 4 ++-- src/fat_boot_sector.ml | 14 +++++++++----- 4 files changed, 13 insertions(+), 11 deletions(-) diff --git a/fat-filesystem.opam b/fat-filesystem.opam index 9d8333a..0ea3db9 100644 --- a/fat-filesystem.opam +++ b/fat-filesystem.opam @@ -7,11 +7,10 @@ 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"} diff --git a/src/dune b/src/dune index 0a6b8e9..82439c4 100644 --- a/src/dune +++ b/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) + (libraries cstruct re re.str mirage-block mirage-kv lwt io-page) (wrapped false) (preprocess (pps ppx_cstruct))) diff --git a/src/fat.ml b/src/fat.ml index ad2b368..d4b27ea 100644 --- a/src/fat.ml +++ b/src/fat.ml @@ -140,9 +140,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 diff --git a/src/fat_boot_sector.ml b/src/fat_boot_sector.ml index 7d75a22..c284824 100644 --- a/src/fat_boot_sector.ml +++ b/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 From 7b970d97ba5d22ac1c1c4edc8117f23bddbea9c9 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Fri, 23 Sep 2022 15:40:02 +0200 Subject: [PATCH 3/6] remove re dependency --- bin/shell.ml | 9 +++++++-- fat-filesystem.opam | 1 - src/dune | 2 +- src/fat_name.ml | 10 +++++++--- src/fat_path.ml | 7 +++++-- 5 files changed, 20 insertions(+), 9 deletions(-) diff --git a/bin/shell.ml b/bin/shell.ml index 5be4cd1..c44adbf 100644 --- a/bin/shell.ml +++ b/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 diff --git a/fat-filesystem.opam b/fat-filesystem.opam index 0ea3db9..5f9cd3d 100644 --- a/fat-filesystem.opam +++ b/fat-filesystem.opam @@ -17,7 +17,6 @@ depends: [ "mirage-kv" {>= "4.0.0"} "mirage-block-combinators" {with-test} "io-page" {>= "2.4.0"} - "re" {>= "1.7.2"} "cmdliner" {>= "1.1.0"} "fmt" {>= "0.8.7"} "alcotest" {with-test} diff --git a/src/dune b/src/dune index 82439c4..b9c4755 100644 --- a/src/dune +++ b/src/dune @@ -1,7 +1,7 @@ (library (name fat_filesystem) (public_name fat-filesystem) - (libraries cstruct re re.str mirage-block mirage-kv lwt io-page) + (libraries cstruct mirage-block mirage-kv lwt io-page) (wrapped false) (preprocess (pps ppx_cstruct))) diff --git a/src/fat_name.ml b/src/fat_name.ml index 4b73709..8eaf1c2 100644 --- a/src/fat_name.ml +++ b/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) @@ -145,7 +149,7 @@ let add_padding p n x = 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 *) diff --git a/src/fat_path.ml b/src/fat_path.ml index fd4a0b8..55e74d9 100644 --- a/src/fat_path.ml +++ b/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 From c9a8c91952f6d9fa782d7a0360247ccb72f459d8 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Fri, 23 Sep 2022 15:55:44 +0200 Subject: [PATCH 4/6] remove io-page dependency --- bin/impl.ml | 4 +--- fat-filesystem.opam | 1 - src/dune | 2 +- src/fat.ml | 4 +--- test/test.ml | 4 +--- 5 files changed, 4 insertions(+), 11 deletions(-) diff --git a/bin/impl.ml b/bin/impl.ml index 04f362f..a495dcb 100644 --- a/bin/impl.ml +++ b/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 -> diff --git a/fat-filesystem.opam b/fat-filesystem.opam index 5f9cd3d..9effc04 100644 --- a/fat-filesystem.opam +++ b/fat-filesystem.opam @@ -16,7 +16,6 @@ depends: [ "mirage-block-unix" {>= "2.13.0"} "mirage-kv" {>= "4.0.0"} "mirage-block-combinators" {with-test} - "io-page" {>= "2.4.0"} "cmdliner" {>= "1.1.0"} "fmt" {>= "0.8.7"} "alcotest" {with-test} diff --git a/src/dune b/src/dune index b9c4755..b5c1af9 100644 --- a/src/dune +++ b/src/dune @@ -1,7 +1,7 @@ (library (name fat_filesystem) (public_name fat-filesystem) - (libraries cstruct mirage-block mirage-kv lwt io-page) + (libraries cstruct mirage-block mirage-kv lwt) (wrapped false) (preprocess (pps ppx_cstruct))) diff --git a/src/fat.ml b/src/fat.ml index d4b27ea..ce32d7d 100644 --- a/src/fat.ml +++ b/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 = diff --git a/test/test.ml b/test/test.ml index e26849e..87685a9 100644 --- a/test/test.ml +++ b/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 -> From 5d40fa4709be6cd757dc23f758773dc570927c14 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Fri, 23 Sep 2022 15:59:20 +0200 Subject: [PATCH 5/6] conform to mirage-kv 5.0.0 API --- fat-filesystem.opam | 2 +- src/fat.ml | 12 ++++++++++++ 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/fat-filesystem.opam b/fat-filesystem.opam index 9effc04..42778e4 100644 --- a/fat-filesystem.opam +++ b/fat-filesystem.opam @@ -14,7 +14,7 @@ depends: [ "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} "cmdliner" {>= "1.1.0"} "fmt" {>= "0.8.7"} diff --git a/src/fat.ml b/src/fat.ml index ce32d7d..191f76a 100644 --- a/src/fat.ml +++ b/src/fat.ml @@ -538,6 +538,18 @@ 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 = + FS.read t (Mirage_kv.Key.to_string key) offset length >|= function + | Error e -> Error (`FS e) + | Ok l -> Ok Cstruct.(to_string (concat l)) + + let size t key = + FS.stat t (Mirage_kv.Key.to_string key) >|= function + | Error `Is_a_directory -> Error (`Value_expected key) + | Error `No_directory_entry -> Error (`Not_found key) + | Error e -> Error (`FS e) + | Ok s -> Ok (Int64.to_int s.size) + let list t key = let name = Mirage_kv.Key.to_string key in let dict_or_value fn = From a124c2d8fad59ca7f0f85e9f716e2f3bac220775 Mon Sep 17 00:00:00 2001 From: PizieDust Date: Thu, 13 Jul 2023 10:56:35 +0100 Subject: [PATCH 6/6] implement functions to comform with mirage.kv_ro interface --- src/fat.ml | 39 +++++++++++++++++++++++++++++---------- 1 file changed, 29 insertions(+), 10 deletions(-) diff --git a/src/fat.ml b/src/fat.ml index 191f76a..4c38043 100644 --- a/src/fat.ml +++ b/src/fat.ml @@ -539,16 +539,29 @@ module KV_RO(B: Mirage_block.S) = struct | Ok l -> Ok Cstruct.(to_string (concat l)) let get_partial t key ~offset ~length = - FS.read t (Mirage_kv.Key.to_string key) offset length >|= function - | Error e -> Error (`FS e) - | Ok l -> Ok Cstruct.(to_string (concat l)) + 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 = - FS.stat t (Mirage_kv.Key.to_string key) >|= function - | Error `Is_a_directory -> Error (`Value_expected key) - | Error `No_directory_entry -> Error (`Not_found key) - | Error e -> Error (`FS e) - | Ok s -> Ok (Int64.to_int s.size) + 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 @@ -567,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