0

Currently working on a mirage block partition issue.

"The current connect interface has the nice property that it is difficult to create overlapping partitions. However, in the context of Mirage the Functoria API doesn't have a concept of pairs. It is not clear to me how or if the current interface can be integrated into the Mirage tool."

So, I need to implement a variant of connect (could be named connect') that takes and offset and a length and returns a single partition.

Existing code in mirage_block_partition.ml:

  module Make(B : Mirage_block.S) = struct
  type t = {
    b : B.t;
    sector_size : int;
    (* inclusive *)
    sector_start : int64;
    (* exclusive *)
    sector_end : int64;
    mutable connected : bool;

  }

  type nonrec error = [ 
    | Mirage_block.error
    | `Block of B.error
    | `Out_of_bounds ]
  type nonrec write_error = [
    | Mirage_block.write_error
    | `Block of B.write_error
    | `Out_of_bounds ]

  let pp_error ppf = function
    | `Block e | (#Mirage_block.error as e) -> B.pp_error ppf e
    | `Out_of_bounds -> Fmt.pf ppf "Operation out of partition bounds"

  let pp_write_error ppf = function
    | `Block e | (#Mirage_block.write_error as e) -> B.pp_write_error ppf e
    | `Out_of_bounds -> Fmt.pf ppf "Operation out of partition bounds"

  let get_info b =
    let size_sectors = Int64.(sub b.sector_end b.sector_start) in
    Lwt.map (fun info -> { info with Mirage_block.size_sectors })
      (B.get_info b.b)

  let get_offset { sector_start; _ } = sector_start

  let is_within b sector_start buffers =
    let buffers_len =
      List.fold_left (fun acc cs -> Int64.(add acc (of_int (Cstruct.length cs))))
        0L buffers
    in
    let num_sectors =
      let sector_size = Int64.of_int b.sector_size in
      Int64.(div (add buffers_len (pred sector_size))
               sector_size)
    in
    let sector_start = Int64.add sector_start b.sector_start in
    let sector_end = Int64.add sector_start num_sectors in
    sector_start >= b.sector_start && sector_end <= b.sector_end

  let read b sector_start buffers =
    (* XXX: here and in [write] we rely on the underlying block device to check
       for alignment issues of [buffers]. *)
    if not (is_within b sector_start buffers) then
      Lwt.return (Error `Out_of_bounds)
    else if not b.connected then
      Lwt.return (Error `Disconnected)
    else
      B.read b.b (Int64.add b.sector_start sector_start) buffers
      |> Lwt_result.map_error (fun b -> `Block b)

  let write b sector_start buffers =
    if not (is_within b sector_start buffers) then
      Lwt.return (Error `Out_of_bounds)
    else if not b.connected then
      Lwt.return (Error `Disconnected)
    else
      B.write b.b (Int64.add b.sector_start sector_start) buffers
      |> Lwt_result.map_error (fun b -> `Block b)

  let partition b ~sector_size ~sector_start ~sector_end ~first_sectors =
    if first_sectors < 0L then
      raise (Invalid_argument "Partition point before device");
    let sector_mid = Int64.add sector_start first_sectors in
    if sector_mid > sector_end then
      raise (Invalid_argument "Partition point beyond device");
    ({ b; sector_size; sector_start; sector_end = sector_mid; connected = true },
     { b; sector_size; sector_start = sector_mid; sector_end; connected = true })

  let connect first_sectors b =
    let open Lwt.Syntax in
    let+ { Mirage_block.sector_size; size_sectors = sector_end; _ } = B.get_info b in
    let sector_start = 0L in
    partition b ~sector_size ~sector_start ~sector_end ~first_sectors

  let subpartition first_sectors { b; sector_size; sector_start; sector_end; connected } =
    if connected then
      partition b ~sector_size ~sector_start ~sector_end ~first_sectors
    else
      invalid_arg "unconnected block"

  let disconnect b =
    if b.connected then
      b.connected <- false;
    Lwt.return_unit
end

I have tried this; But still not working...

let connect' (offset:int) (length:int) =
  partition b ~sector_size ~sector_start ~sector_end ~first_sectors

I want the code to match this interface for mli file val connect' : int -> int -> t

0 Answers0