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/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 d6ec063..42778e4 100644 --- a/fat-filesystem.opam +++ b/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} ] diff --git a/src/dune b/src/dune index c991815..b5c1af9 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 astring) + (libraries cstruct mirage-block mirage-kv lwt) (wrapped false) (preprocess (pps ppx_cstruct))) diff --git a/src/fat.ml b/src/fat.ml index ad2b368..4c38043 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 = @@ -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 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 diff --git a/src/fat_name.ml b/src/fat_name.ml index 7700cc7..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) @@ -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 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 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 ->