Source file mirage_block_partition_mbr.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
module Make(B : Mirage_block.S) = struct
module P = Mirage_block_partition.Make(B)
include P
type section =
| Unused of int64
| Partition of Mbr.Partition.t * int64
let sections offset partitions =
List.fold_left
(fun r p ->
let ( let* ) = Result.bind in
let* offset, ps = r in
let sector_start = Mbr.Partition.sector_start p
and size_sectors = Mbr.Partition.size_sectors p in
let* () =
if sector_start < offset then
Error `Overlapping_partitions
else Ok ()
in
let p =
Partition (p, size_sectors)
in
let ps =
if sector_start > offset then
p :: Unused (Int64.sub offset sector_start) :: ps
else
p :: ps
in
Ok (Int64.add sector_start size_sectors, ps))
(Ok (offset, []))
partitions
|> Result.map snd
|> Result.map List.rev
let subpartition b (mbr : Mbr.t) =
let partitions =
List.sort (fun p1 p2 ->
Int32.unsigned_compare
p1.Mbr.Partition.first_absolute_sector_lba
p2.Mbr.Partition.first_absolute_sector_lba)
mbr.partitions
in
match sections (P.get_offset b) partitions with
| Error _ as e -> e
| Ok partitioning ->
List.fold_left
(fun acc p ->
let ( let* ) = Result.bind in
let* rest, ps = acc in
match p with
| Unused length ->
let _, rest = P.subpartition length rest in
Ok (rest, ps)
| Partition (p, length) ->
let b, rest = P.subpartition length rest in
Ok (rest, (p, b) :: ps))
(Ok (b, []))
partitioning
|> Result.map snd
|> Result.map List.rev
let connect b =
let open Lwt.Syntax in
let* { Mirage_block.sector_size; _ } = B.get_info b in
if sector_size <> Mbr.sizeof then
Printf.ksprintf invalid_arg "Bad sector size: %d" sector_size;
let* (mbr, rest) = P.connect 1L b in
let buf = Cstruct.create Mbr.sizeof in
let* r = P.read mbr 0L [buf] in
begin match r with
| Error e -> Format.kasprintf failwith "MBR read error: %a" pp_error e
| Ok () -> ()
end;
match Mbr.unmarshal buf with
| Error e -> Printf.ksprintf Lwt.fail_with "Bad MBR: %s" e
| Ok mbr ->
Lwt.return (subpartition rest mbr)
end