mirage / ocaml-fat

Read and write FAT format filesystems from OCaml
ISC License
26 stars 18 forks source link

Writing to a new path leads to "Assertion failured" #35

Open talex5 opened 10 years ago

talex5 commented 10 years ago

Test-case:

open Lwt

module F = Fat.Fs.Make(Block)(Io_page)

let (>>|=) x f = x >>= function
  | `Error e -> failwith (Fat.Fs.string_of_filesystem_error e)
  | `Ok v -> f v

let main =
  Block.connect "disk.img" >>= function
  | `Error (`Unknown msg) -> failwith msg
  | `Error _ -> failwith "Block error"
  | `Ok block ->
  F.connect block >>|= fun fs ->
  F.format fs 0x100000L >>|= fun () ->
  let data = Cstruct.of_string "hi" in
(*   F.create fs "/data" >>|= fun () -> *)
  F.write fs "/data" 0 data >>|= fun () ->
  F.listdir fs "/" >>|= fun items ->
  List.iter (Printf.printf "Item: %s\n") items;
  print_endline "Done listing.";
  return ()

let () = Lwt_unix.run main

Results:

Fatal error: exception Failure("Unknown error: File "lib/fs.ml", line 263, characters 22-28: Assertion failed")

The comment and/or code in chain_of_file looks wrong. It says it returns None if the path doesn't exist, but in fact it asserts false in that case:

(** [chain_of_file device fs path] returns [Some chain] where [chain] is the chain
    corresponding to [path] or [None] if [path] cannot be found or if it
    is / and hasn't got a chain. *)
let chain_of_file device fs path =
  if Path.is_root path then return None
  else
    let parent_path = Path.directory path in
    find device fs parent_path >>= fun entry ->
    match entry with
    | `Ok (Dir ds) ->
      begin match Name.find (Path.filename path) ds with
        | None -> assert false
        | Some f ->
          let start_cluster = (snd f.Name.dos).Name.start_cluster in
          return (Some(Entry.Chain.follow fs.format fs.fat start_cluster))
      end
    | _ -> return None

I tried modifying it to return None instead, but that causes corruption because the of_file function treats None as indicating the root directory, causing the write to corrupt that.