upstream: https://github.com/mirage/ocaml-mbr
Squashed 'ocaml-mbr/' content from commit 6d5206bf git-subtree-split: 6d5206bff6f59f589fca636fa00a157461fa0d27
+1246
+14
.gitignore
+14
.gitignore
+4
.ocamlformat
+4
.ocamlformat
+26
CHANGES.md
+26
CHANGES.md
···
1
+
## v2.0.0 (2023-04-19)
2
+
* Add optional argument `?disk_signature` to `Mbr.make` (@Burnleydev1, review by @reynir, #19)
3
+
* Make the partition type a required argument to `Mbr.Partition.make` and rename it `~partition_type` (@AryanGodara, review by @reynir, #20)
4
+
* Add tools for inspecting and modifying MBR, and reading/writing data to partitions. The command line tools are not installed as part of the opam package. The tools are `bin/mbr_inspect.exe`, `bin/read_partition.exe`, `bin/resize_partition.exe` and `bin/write_partition.exe`. (@PizieDust, review by @reynir, #22, #23, #24, #26)
5
+
* Remove dependency on `ppx_cstruct` (@reynir, #27)
6
+
7
+
## v1.0 (2022-09-27)
8
+
* Switch to dune
9
+
* Remove `Mbr_partition` and `Mbr_lwt`
10
+
* Remove old stringly typed interface
11
+
* Types are private
12
+
* Add helper functions to convert between uint32 MBR values and int64 values as expected in `Mirage_block`
13
+
* Update code and slim down on dependencies
14
+
* Handle empty partition entries
15
+
16
+
## v0.3 (2015-06-04)
17
+
* Expose a `connect` function for mirage-types > 2.3
18
+
* Fix bounds checks
19
+
* Add unit tests
20
+
* Fix integer overflow
21
+
* Add opam file
22
+
23
+
## v0.2 (2014-08-18)
24
+
* add `Mbr_partition: V1_LWT.BLOCK`, for easy access to partitions via
25
+
the standard Mirage block interface.
26
+
* use a polymorphic variant result type `` [`Ok of 'a | `Error of 'b]``
+14
LICENSE
+14
LICENSE
···
1
+
Copyright (c) 2014, Citrix Systems Inc
2
+
3
+
Permission to use, copy, modify, and/or distribute this software for any
4
+
purpose with or without fee is hereby granted, provided that the above
5
+
copyright notice and this permission notice appear in all copies.
6
+
7
+
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
8
+
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
9
+
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
10
+
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
11
+
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
12
+
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
13
+
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
14
+
+37
README.md
+37
README.md
···
1
+
ocaml-mbr
2
+
=========
3
+
4
+
A library for manipulating Master Boot Records. The
5
+
primary purposes of this library are:
6
+
1. to create bootable disk images creating
7
+
[mirage](http://www.openmirage.org/) kernels
8
+
2. for mirage kernels to read the partition tables on
9
+
attached disks
10
+
11
+
Usage
12
+
-----
13
+
Define a single partition as follows:
14
+
```
15
+
let disk_length_bytes = Int32.(mul (mul 16l 1024l) 1024l) in
16
+
let disk_length_sectors = Int32.(div disk_length_bytes 512l) in
17
+
18
+
let start_sector = 2048l in
19
+
let length_sectors = Int32.sub disk_length_sectors start_sector in
20
+
let partition = Mbr.Partition.make ~active:true ~ty:6 start_sector length_sectors in
21
+
let mbr = Mbr.make [ partition ] in
22
+
```
23
+
You can write the MBR to sector zero of a block device ```B``` as follows:
24
+
```
25
+
B.connect id >>= fun device ->
26
+
let sector = Cstruct.create 512 in
27
+
Mbr.marshal sector mbr;
28
+
B.write device 0L [ sector ] >>= fun () ->
29
+
...
30
+
```
31
+
32
+
To do items
33
+
-----------
34
+
35
+
* Implement tools to manipulate MBR-formatted disk images
36
+
to construct, inspect or fill partitions that can later
37
+
be used in Mirage unikernels.
+3
bin/dune
+3
bin/dune
+64
bin/mbr_inspect.ml
+64
bin/mbr_inspect.ml
···
1
+
open Cmdliner
2
+
3
+
let print_mbr_fields print_bootstrap_code mbr =
4
+
Printf.printf "MBR fields:\n";
5
+
if print_bootstrap_code then
6
+
Printf.printf " bootstrap_code: %s\n"
7
+
(Cstruct.to_hex_string (Cstruct.of_string mbr.Mbr.bootstrap_code));
8
+
Printf.printf " original_physical_drive: %d\n"
9
+
mbr.Mbr.original_physical_drive;
10
+
Printf.printf " seconds: %d\n" mbr.Mbr.seconds;
11
+
Printf.printf " minutes: %d\n" mbr.Mbr.minutes;
12
+
Printf.printf " hours: %d\n" mbr.Mbr.hours;
13
+
Printf.printf " disk_signature: %lx\n" mbr.Mbr.disk_signature;
14
+
List.iteri
15
+
(fun i part ->
16
+
let chs_begin = part.Mbr.Partition.first_absolute_sector_chs in
17
+
let chs_end = part.Mbr.Partition.last_absolute_sector_chs in
18
+
Printf.printf " Partition %d:\n" (i + 1);
19
+
Printf.printf " bootable: %b\n" part.Mbr.Partition.active;
20
+
let { Mbr.Geometry.cylinders; Mbr.Geometry.heads; Mbr.Geometry.sectors } =
21
+
chs_begin
22
+
in
23
+
Printf.printf " chs_begin: (cylinders: %d, heads: %d, sectors: %d)\n"
24
+
cylinders heads sectors;
25
+
Printf.printf " ty: %02x\n" part.Mbr.Partition.ty;
26
+
let { Mbr.Geometry.cylinders; Mbr.Geometry.heads; Mbr.Geometry.sectors } =
27
+
chs_end
28
+
in
29
+
Printf.printf " chs_end: (cylinders: %d, heads: %d, sectors: %d)\n"
30
+
cylinders heads sectors;
31
+
Printf.printf " lba_begin: %ld\n"
32
+
part.Mbr.Partition.first_absolute_sector_lba;
33
+
Printf.printf " size_sectors: %ld\n" part.Mbr.Partition.sectors)
34
+
mbr.partitions
35
+
36
+
let read_mbrs print_bootstrap_code mbrs =
37
+
List.iter
38
+
(fun mbr ->
39
+
let ic = open_in_bin mbr in
40
+
let buf = Bytes.create Mbr.sizeof in
41
+
let () = really_input ic buf 0 Mbr.sizeof in
42
+
close_in ic;
43
+
match Mbr.unmarshal (Cstruct.of_bytes buf) with
44
+
| Ok mbr -> print_mbr_fields print_bootstrap_code mbr
45
+
| Error msg ->
46
+
Printf.printf "Failed to read MBR from %s: %s\n" mbr msg;
47
+
exit 1)
48
+
mbrs
49
+
50
+
let mbrs = Arg.(non_empty & pos_all file [] & info [] ~docv:"disk_images")
51
+
52
+
let print_bootstrap_code =
53
+
let doc = "Print the bootstrap code of the disks images." in
54
+
Arg.(value & flag & info [ "b"; "booststrap-code" ] ~doc)
55
+
56
+
let cmd =
57
+
let doc =
58
+
"Inspect the Master Boot Record (MBR) headers of one or more disk images."
59
+
in
60
+
let info = Cmd.info "mbr_inspect" ~version:"1.0.0" ~doc in
61
+
Cmd.v info Term.(const read_mbrs $ print_bootstrap_code $ mbrs)
62
+
63
+
let main () = exit (Cmd.eval cmd)
64
+
let () = main ()
+88
bin/read_partition.ml
+88
bin/read_partition.ml
···
1
+
open Cmdliner
2
+
3
+
let read_mbr mbr =
4
+
let ic = open_in_bin mbr in
5
+
let buf = Bytes.create Mbr.sizeof in
6
+
let () = really_input ic buf 0 Mbr.sizeof in
7
+
close_in ic;
8
+
match Mbr.unmarshal (Cstruct.of_bytes buf) with
9
+
| Ok mbr -> mbr
10
+
| Error msg ->
11
+
Printf.printf "Failed to read MBR from %s: %s\n" mbr msg;
12
+
exit 1
13
+
14
+
let get_partition_info mbr partition_num =
15
+
let mbr = read_mbr mbr in
16
+
match partition_num with
17
+
| 1 | 2 | 3 | 4 -> List.nth mbr.Mbr.partitions (partition_num - 1)
18
+
| _ -> failwith "Partition number must be between 1 and 4"
19
+
20
+
let calculate_partition_info partition =
21
+
let start_sector =
22
+
Int32.to_int partition.Mbr.Partition.first_absolute_sector_lba
23
+
in
24
+
let num_sectors = Int32.to_int partition.Mbr.Partition.sectors in
25
+
let sector_size = 512 in
26
+
(start_sector, num_sectors, sector_size)
27
+
28
+
let read_partition_data mbr start_sector num_sectors sector_size output =
29
+
let buffer_size = 4096 in
30
+
let buffer = Bytes.create buffer_size in
31
+
let ic = open_in_bin mbr in
32
+
let offset = start_sector * sector_size in
33
+
let () = seek_in ic offset in
34
+
let rec loop remaining_bytes =
35
+
if remaining_bytes > 0 then
36
+
let bytes_to_read = min buffer_size remaining_bytes in
37
+
let () = really_input ic buffer 0 bytes_to_read in
38
+
(* [Bytes.unsafe_to_string buffer] is safe here because [output] will not
39
+
keep the string once returned. *)
40
+
let () = output (Bytes.unsafe_to_string buffer) 0 bytes_to_read in
41
+
loop (remaining_bytes - bytes_to_read)
42
+
else ()
43
+
in
44
+
loop (num_sectors * sector_size);
45
+
close_in ic
46
+
47
+
let writer output_channel buffer offset length =
48
+
output_substring output_channel buffer offset length
49
+
50
+
let extract_partition_data mbr partition_num output_file =
51
+
let partition = get_partition_info mbr partition_num in
52
+
let start_sector, num_sectors, sector_size =
53
+
calculate_partition_info partition
54
+
in
55
+
match output_file with
56
+
| None ->
57
+
read_partition_data mbr start_sector num_sectors sector_size
58
+
(writer stdout)
59
+
| Some file_path ->
60
+
let oc =
61
+
open_out_gen [ Open_wronly; Open_creat; Open_trunc ] 0o666 file_path
62
+
in
63
+
let () =
64
+
read_partition_data mbr start_sector num_sectors sector_size (writer oc)
65
+
in
66
+
close_out oc
67
+
68
+
let mbr =
69
+
let doc = "The disk image containing the partition" in
70
+
Arg.(required & pos 0 (some file) None & info [] ~docv:"disk_image" ~doc)
71
+
72
+
let partition_number =
73
+
let doc = "The partition number to read" in
74
+
Arg.(required & pos 1 (some int) None & info [] ~docv:"partition_number" ~doc)
75
+
76
+
let output_to_file =
77
+
let doc = "Output partition contents to a file" in
78
+
Arg.(value & opt (some string) None & info [ "f"; "file" ] ~doc)
79
+
80
+
let cmd =
81
+
let doc = "Read the contents of a partition" in
82
+
let info = Cmd.info "read_partition" ~version:"1.0.0" ~doc in
83
+
Cmd.v info
84
+
Term.(
85
+
const extract_partition_data $ mbr $ partition_number $ output_to_file)
86
+
87
+
let main () = exit (Cmd.eval cmd)
88
+
let () = main ()
+100
bin/resize_partition.ml
+100
bin/resize_partition.ml
···
1
+
open Cmdliner
2
+
3
+
let read_mbr mbr =
4
+
let ic = open_in_bin mbr in
5
+
let buf = Bytes.create Mbr.sizeof in
6
+
let () = really_input ic buf 0 Mbr.sizeof in
7
+
close_in ic;
8
+
match Mbr.unmarshal (Cstruct.of_bytes buf) with
9
+
| Ok mbr -> (mbr, Mbr.sizeof)
10
+
| Error msg ->
11
+
Printf.printf "Failed to read MBR from %s: %s\n" mbr msg;
12
+
exit 1
13
+
14
+
let get_partition_info mbr partition_number =
15
+
List.nth mbr.Mbr.partitions (partition_number - 1)
16
+
17
+
let calculate_partition_info partition =
18
+
(* FIXME: Use Int32.unsigned_to_int *)
19
+
let start_sector =
20
+
Int32.to_int partition.Mbr.Partition.first_absolute_sector_lba
21
+
in
22
+
let num_sectors = Int32.to_int partition.Mbr.Partition.sectors in
23
+
let sector_size = 512 in
24
+
Printf.printf "Current partition size: %d bytes\n" (num_sectors * sector_size);
25
+
(start_sector, sector_size)
26
+
27
+
let make_new_partition partition start_sector sector_size new_size =
28
+
if new_size mod sector_size <> 0 then
29
+
Printf.ksprintf failwith
30
+
"Partition cannot be resized. New size of %d bytes does not align to \
31
+
sectors. New size must be a multiple of %d"
32
+
new_size sector_size
33
+
else
34
+
let new_num_sectors = new_size / sector_size in
35
+
let new_end_sector = start_sector + new_num_sectors in
36
+
Printf.printf "New partition size: %d bytes\n"
37
+
(new_num_sectors * sector_size);
38
+
match
39
+
Mbr.Partition.make ~active:partition.Mbr.Partition.active
40
+
~partition_type:partition.Mbr.Partition.ty
41
+
partition.Mbr.Partition.first_absolute_sector_lba
42
+
(Int32.of_int new_end_sector)
43
+
with
44
+
| Ok new_partition -> new_partition
45
+
| Error msg -> failwith msg
46
+
47
+
let replace_partition_in_partition_table mbr partition_number new_partition =
48
+
let update_partition i p =
49
+
if i = partition_number - 1 then new_partition else p
50
+
in
51
+
List.mapi update_partition mbr.Mbr.partitions
52
+
53
+
(* Mbr.make smart constructor checks for partition overlap, more than 1 active partitions and too many partitions *)
54
+
let make_new_mbr mbr new_partition_table =
55
+
match Mbr.make ~disk_signature:mbr.Mbr.disk_signature new_partition_table with
56
+
| Ok new_mbr -> new_mbr
57
+
| Error msg -> failwith msg
58
+
59
+
let resize_partition mbr partition_number new_size =
60
+
let disk = mbr in
61
+
let mbr = read_mbr mbr |> fst in
62
+
let partition = get_partition_info mbr partition_number in
63
+
let start_sector, sector_size = calculate_partition_info partition in
64
+
let new_partition =
65
+
make_new_partition partition start_sector sector_size new_size
66
+
in
67
+
let new_partition_table =
68
+
replace_partition_in_partition_table mbr partition_number new_partition
69
+
in
70
+
let new_mbr = make_new_mbr mbr new_partition_table in
71
+
let oc = open_out_gen [ Open_wronly; Open_binary ] 0o644 disk in
72
+
seek_out oc 0;
73
+
let buf = Cstruct.create Mbr.sizeof in
74
+
Mbr.marshal buf new_mbr;
75
+
let mbr_bytes = Cstruct.to_bytes buf in
76
+
output oc mbr_bytes 0 Mbr.sizeof;
77
+
close_out_noerr oc
78
+
79
+
let mbr =
80
+
let doc = "The disk image containing the partition." in
81
+
Arg.(required & pos 0 (some file) None & info [] ~docv:"disk_image" ~doc)
82
+
83
+
let partition_number =
84
+
let doc = "The partition number to resize. Indexed from 1 to 4." in
85
+
Arg.(required & pos 1 (some int) None & info [] ~docv:"partition_number" ~doc)
86
+
87
+
let new_size =
88
+
let doc =
89
+
"The new size of the partition in bytes. The size has to be aligned with \
90
+
the sector size, i.e. a multiple of 512."
91
+
in
92
+
Arg.(required & pos 2 (some int) None & info [] ~docv:"new_size" ~doc)
93
+
94
+
let cmd =
95
+
let doc = "Resize a partition" in
96
+
let info = Cmd.info "resize_partition" ~version:"1.0.0" ~doc in
97
+
Cmd.v info Term.(const resize_partition $ mbr $ partition_number $ new_size)
98
+
99
+
let main () = exit (Cmd.eval cmd)
100
+
let () = main ()
+95
bin/write_partition.ml
+95
bin/write_partition.ml
···
1
+
open Cmdliner
2
+
3
+
let read_mbr mbr =
4
+
let ic = open_in_bin mbr in
5
+
let buf = Bytes.create Mbr.sizeof in
6
+
let () = really_input ic buf 0 Mbr.sizeof in
7
+
close_in ic;
8
+
match Mbr.unmarshal (Cstruct.of_bytes buf) with
9
+
| Ok mbr -> (mbr, Mbr.sizeof)
10
+
| Error msg ->
11
+
Printf.printf "Failed to read MBR from %s: %s\n" mbr msg;
12
+
exit 1
13
+
14
+
let get_partition_info mbr partition_num =
15
+
let mbr = read_mbr mbr |> fst in
16
+
List.nth mbr.Mbr.partitions (partition_num - 1)
17
+
18
+
let calculate_partition_info partition =
19
+
(* FIXME: Use Int32.unsigned_to_int *)
20
+
let start_sector =
21
+
Int32.to_int partition.Mbr.Partition.first_absolute_sector_lba
22
+
in
23
+
let num_sectors = Int32.to_int partition.Mbr.Partition.sectors in
24
+
let sector_size = 512 in
25
+
(start_sector, num_sectors, sector_size)
26
+
27
+
let copy ic oc max_bytes =
28
+
let buf_len = 4096 in
29
+
let buf = Bytes.create buf_len in
30
+
let rec loop i =
31
+
let len = input ic buf 0 buf_len in
32
+
if len > 0 then (
33
+
let len' = min len (max_bytes - i) in
34
+
output oc buf 0 len';
35
+
if i + len > max_bytes then
36
+
failwith "Trying to write more than can fit in partition";
37
+
loop (i + len'))
38
+
else ()
39
+
in
40
+
loop 0
41
+
42
+
let write_to_partition mbr partition_number input_data =
43
+
let partition = get_partition_info mbr partition_number in
44
+
let start_sector, num_sectors, sector_size =
45
+
calculate_partition_info partition
46
+
in
47
+
if start_sector = 0 then
48
+
Printf.ksprintf failwith
49
+
"Writing to partition %d would overwrite the MBR header" partition_number;
50
+
let ic, data_size =
51
+
match input_data with
52
+
| None -> (stdin, None)
53
+
| Some file_path ->
54
+
let file_info = Unix.stat file_path in
55
+
let data_size = file_info.st_size in
56
+
let ic = open_in_bin file_path in
57
+
(ic, Some data_size)
58
+
in
59
+
let partition_size = num_sectors * sector_size in
60
+
Option.iter
61
+
(fun data_size -> Printf.printf "Total input size: %d\n" data_size)
62
+
data_size;
63
+
Printf.printf "Total Partition size: %d\n" partition_size;
64
+
Option.iter
65
+
(fun data_size ->
66
+
if data_size > partition_size then
67
+
failwith "Input is too large for partition")
68
+
data_size;
69
+
Printf.printf "\nBegin writing to partition:- \n";
70
+
let oc = open_out_gen [ Open_wronly; Open_binary ] 0o644 mbr in
71
+
seek_out oc (start_sector * sector_size);
72
+
copy ic oc partition_size;
73
+
close_out_noerr oc;
74
+
close_in_noerr ic
75
+
76
+
let mbr =
77
+
let doc = "The disk image containing the partition" in
78
+
Arg.(required & pos 0 (some file) None & info [] ~docv:"disk_image" ~doc)
79
+
80
+
let partition_number =
81
+
let doc = "The partition number to write to" in
82
+
Arg.(required & pos 1 (some int) None & info [] ~docv:"partition_number" ~doc)
83
+
84
+
let input_data =
85
+
let doc = "The data to write to the partition." in
86
+
Arg.(value & opt (some string) None & info [ "d"; "data" ] ~doc ~docv:"FILE")
87
+
88
+
let cmd =
89
+
let doc = "Write data into a partition" in
90
+
let info = Cmd.info "write_partition" ~version:"1.0.0" ~doc in
91
+
Cmd.v info
92
+
Term.(const write_to_partition $ mbr $ partition_number $ input_data)
93
+
94
+
let main () = exit (Cmd.eval cmd)
95
+
let () = main ()
+30
dune-project
+30
dune-project
···
1
+
(lang dune 3.17)
2
+
3
+
(name mbr-format)
4
+
5
+
(generate_opam_files true)
6
+
7
+
(license ISC)
8
+
9
+
(authors
10
+
"David Scott <dave.scott@eu.citrix.com>"
11
+
"Reynir Björnsson <reynir@reynir.dk>")
12
+
13
+
(maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>")
14
+
15
+
(source
16
+
(uri https://tangled.org/gazagnaire.org/ocaml-mbr))
17
+
18
+
(bug_reports "https://tangled.org/gazagnaire.org/ocaml-mbr/issues")
19
+
20
+
(package
21
+
(name mbr-format)
22
+
(synopsis "A library to manipulate Master Boot Records")
23
+
(description
24
+
"Pure OCaml library for reading and writing Master Boot Records (MBR).
25
+
Useful for creating bootable disk images and reading partition tables.")
26
+
(depends
27
+
(ocaml (>= 5.1))
28
+
(bytesrw (>= 0.1))
29
+
(alcotest :with-test)
30
+
(crowbar :with-test)))
+23
fuzz/dune
+23
fuzz/dune
···
1
+
; Crowbar fuzz testing for mbr-format
2
+
;
3
+
; Run: dune exec fuzz/fuzz_mbr.exe
4
+
; AFL: afl-fuzz -i fuzz/input -o fuzz/findings -- ./_build/default/fuzz/fuzz_mbr.exe @@
5
+
6
+
(executable
7
+
(name fuzz_mbr)
8
+
(libraries mbr-format crowbar))
9
+
10
+
(rule
11
+
(alias fuzz)
12
+
(deps fuzz_mbr.exe)
13
+
(action
14
+
(run %{exe:fuzz_mbr.exe})))
15
+
16
+
; AFL-instrumented build target
17
+
18
+
(rule
19
+
(alias fuzz-afl)
20
+
(deps
21
+
(glob_files *.ml))
22
+
(action
23
+
(run echo "Build with: dune build --profile=afl fuzz/fuzz_mbr.exe")))
+88
fuzz/fuzz_mbr.ml
+88
fuzz/fuzz_mbr.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Fuzz tests for MBR parsing.
7
+
8
+
Key properties tested:
9
+
1. Parser crash safety - no crashes on arbitrary 512-byte input
10
+
2. Roundtrip - marshal(unmarshal(x)) produces valid MBR
11
+
3. Partition bounds - start + size doesn't overflow
12
+
13
+
Security considerations:
14
+
- MBR parsers have historically had integer overflow bugs
15
+
- Malformed partition entries shouldn't cause crashes
16
+
- CHS values can be crafted to cause issues *)
17
+
18
+
open Crowbar
19
+
20
+
(** Truncate input to reasonable size. *)
21
+
let truncate ?(max_len = 512) buf =
22
+
let len = min max_len (String.length buf) in
23
+
String.sub buf 0 len
24
+
25
+
(** MBR unmarshal crash safety.
26
+
Parser must not crash on any 512-byte input. *)
27
+
let test_unmarshal_crash_safety buf =
28
+
let buf = truncate ~max_len:512 buf in
29
+
(* Pad to 512 bytes if needed *)
30
+
let buf =
31
+
if String.length buf < 512 then
32
+
buf ^ String.make (512 - String.length buf) '\x00'
33
+
else buf
34
+
in
35
+
let _ = Mbr.of_string buf in
36
+
()
37
+
38
+
(** MBR roundtrip - valid MBRs should survive marshal/unmarshal. *)
39
+
let test_roundtrip () =
40
+
(* Create a simple valid MBR *)
41
+
let p1 =
42
+
match Mbr.Partition.make ~active:false ~partition_type:0x83 2048l 1048576l with
43
+
| Ok p -> p
44
+
| Error _ -> fail "failed to create partition"
45
+
in
46
+
let mbr =
47
+
match Mbr.make [ p1 ] with
48
+
| Ok m -> m
49
+
| Error _ -> fail "failed to create MBR"
50
+
in
51
+
let buf = Mbr.to_string mbr in
52
+
match Mbr.of_string buf with
53
+
| Error _ -> fail "roundtrip failed: unmarshal error"
54
+
| Ok mbr' ->
55
+
let partitions = Mbr.partitions mbr in
56
+
let partitions' = Mbr.partitions mbr' in
57
+
if List.length partitions <> List.length partitions' then
58
+
fail "roundtrip: partition count mismatch"
59
+
60
+
(** Partition make with arbitrary values - must not crash. *)
61
+
let test_partition_make active ptype start size =
62
+
let active = active mod 2 = 0 in
63
+
let ptype = ptype mod 256 in
64
+
let start = Int32.of_int (start mod 0x7FFFFFFF) in
65
+
let size = Int32.of_int (size mod 0x7FFFFFFF) in
66
+
let _ = Mbr.Partition.make ~active ~partition_type:ptype start size in
67
+
()
68
+
69
+
(** MBR make with multiple partitions. *)
70
+
let test_mbr_make p1_start p1_size p2_start p2_size =
71
+
let p1_start = Int32.of_int ((abs p1_start mod 0x7FFFFFFF) + 1) in
72
+
let p1_size = Int32.of_int ((abs p1_size mod 0x7FFFFF) + 1) in
73
+
let p2_start = Int32.of_int ((abs p2_start mod 0x7FFFFFFF) + 1) in
74
+
let p2_size = Int32.of_int ((abs p2_size mod 0x7FFFFF) + 1) in
75
+
let p1 = Mbr.Partition.make ~active:false ~partition_type:0x83 p1_start p1_size in
76
+
let p2 = Mbr.Partition.make ~active:false ~partition_type:0x83 p2_start p2_size in
77
+
match p1, p2 with
78
+
| Ok p1, Ok p2 ->
79
+
(* MBR.make may fail due to overlap, that's OK *)
80
+
let _ = Mbr.make [ p1; p2 ] in
81
+
()
82
+
| _ -> ()
83
+
84
+
let () =
85
+
add_test ~name:"mbr: unmarshal crash safety" [ bytes ] test_unmarshal_crash_safety;
86
+
add_test ~name:"mbr: roundtrip" [] test_roundtrip;
87
+
add_test ~name:"mbr: partition make" [ int; int; int; int ] test_partition_make;
88
+
add_test ~name:"mbr: make with partitions" [ int; int; int; int ] test_mbr_make
+1
fuzz/input/seed
+1
fuzz/input/seed
···
1
+
seed
+5
lib/dune
+5
lib/dune
+375
lib/mbr.ml
+375
lib/mbr.ml
···
1
+
(*
2
+
* Copyright (C) 2013 Citrix Inc
3
+
*
4
+
* Permission to use, copy, modify, and distribute this software for any
5
+
* purpose with or without fee is hereby granted, provided that the above
6
+
* copyright notice and this permission notice appear in all copies.
7
+
*
8
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
+
*)
16
+
17
+
module Result_syntax = struct
18
+
let ( let* ) = Result.bind
19
+
end
20
+
21
+
open Result_syntax
22
+
23
+
(* Binary reading helpers - little-endian *)
24
+
let get_u8 s off = Char.code (Bytes.get s off)
25
+
let get_u16_le s off = get_u8 s off lor (get_u8 s (off + 1) lsl 8)
26
+
27
+
let get_u32_le s off =
28
+
Int32.logor
29
+
(Int32.of_int (get_u16_le s off))
30
+
(Int32.shift_left (Int32.of_int (get_u16_le s (off + 2))) 16)
31
+
32
+
(* Binary writing helpers - little-endian *)
33
+
let set_u8 s off v = Bytes.set s off (Char.chr (v land 0xff))
34
+
35
+
let set_u16_le s off v =
36
+
set_u8 s off (v land 0xff);
37
+
set_u8 s (off + 1) ((v lsr 8) land 0xff)
38
+
39
+
let set_u32_le s off v =
40
+
set_u16_le s off (Int32.to_int (Int32.logand v 0xffffl));
41
+
set_u16_le s (off + 2)
42
+
(Int32.to_int (Int32.logand (Int32.shift_right_logical v 16) 0xffffl))
43
+
44
+
(* Check all bytes in range are zero *)
45
+
let bytes_all_zero buf off len =
46
+
let rec check i = i >= len || (get_u8 buf (off + i) = 0 && check (i + 1)) in
47
+
check 0
48
+
49
+
module Reader = Bytesrw.Bytes.Reader
50
+
module Writer = Bytesrw.Bytes.Writer
51
+
module Slice = Bytesrw.Bytes.Slice
52
+
53
+
(* Read exactly n bytes from reader *)
54
+
let read_exactly reader n =
55
+
if n = 0 then Ok Bytes.empty
56
+
else
57
+
let buf = Bytes.create n in
58
+
let rec loop pos remaining =
59
+
if remaining = 0 then Ok buf
60
+
else
61
+
match Reader.read reader with
62
+
| slice when Slice.is_eod slice -> Error "unexpected end of data"
63
+
| slice ->
64
+
let str = Slice.to_string slice in
65
+
let available = String.length str in
66
+
let to_copy = min available remaining in
67
+
Bytes.blit_string str 0 buf pos to_copy;
68
+
if to_copy < available then begin
69
+
let leftover = String.sub str to_copy (available - to_copy) in
70
+
Reader.push_back reader (Slice.of_string leftover)
71
+
end;
72
+
loop (pos + to_copy) (remaining - to_copy)
73
+
in
74
+
loop 0 n
75
+
76
+
module Geometry = struct
77
+
type t = { cylinders : int; heads : int; sectors : int }
78
+
79
+
let kib = 1024L
80
+
let mib = Int64.mul kib 1024L
81
+
let sizeof = 3
82
+
83
+
let unmarshal buf off : (t, _) result =
84
+
let* () =
85
+
if Bytes.length buf < off + sizeof then
86
+
Error
87
+
(Printf.sprintf "geometry too small: %d < %d"
88
+
(Bytes.length buf - off)
89
+
sizeof)
90
+
else Ok ()
91
+
in
92
+
let heads = get_u8 buf off in
93
+
let y = get_u8 buf (off + 1) in
94
+
let z = get_u8 buf (off + 2) in
95
+
let sectors = y land 0b0111111 in
96
+
let cylinders = (y lsl 2) lor z in
97
+
Ok { cylinders; heads; sectors }
98
+
99
+
let of_lba_size x =
100
+
let sectors = 63 in
101
+
let* heads =
102
+
if x < Int64.(mul 504L mib) then Ok 16
103
+
else if x < Int64.(mul 1008L mib) then Ok 64
104
+
else if x < Int64.(mul 4032L mib) then Ok 128
105
+
else if x < Int64.(add (mul 8032L mib) (mul 512L kib)) then Ok 255
106
+
else Error (Printf.sprintf "sector count exceeds LBA max: %Ld" x)
107
+
in
108
+
let cylinders =
109
+
Int64.(to_int (div (div x (of_int sectors)) (of_int heads)))
110
+
in
111
+
Ok { cylinders; heads; sectors }
112
+
113
+
let to_chs g x =
114
+
let open Int64 in
115
+
let cylinders = to_int (div x (mul (of_int g.sectors) (of_int g.heads))) in
116
+
let heads = to_int (rem (div x (of_int g.sectors)) (of_int g.heads)) in
117
+
let sectors = to_int (succ (rem x (of_int g.sectors))) in
118
+
{ cylinders; heads; sectors }
119
+
end
120
+
121
+
module Partition = struct
122
+
type t = {
123
+
active : bool;
124
+
first_absolute_sector_chs : Geometry.t;
125
+
ty : int;
126
+
last_absolute_sector_chs : Geometry.t;
127
+
first_absolute_sector_lba : int32;
128
+
sectors : int32;
129
+
}
130
+
131
+
let sector_start t =
132
+
Int64.(logand (of_int32 t.first_absolute_sector_lba) 0xFFFF_FFFFL)
133
+
134
+
let size_sectors t = Int64.(logand (of_int32 t.sectors) 0xFFFF_FFFFL)
135
+
136
+
let make ?(active = false) ~partition_type:(ty : int)
137
+
first_absolute_sector_lba sectors =
138
+
let* () =
139
+
if ty > 0 && ty < 256 then Ok ()
140
+
else Error "Mbr.Partition.make: ty must be between 1 and 255"
141
+
in
142
+
let first_absolute_sector_chs =
143
+
{ Geometry.cylinders = 0; heads = 0; sectors = 0 }
144
+
in
145
+
let last_absolute_sector_chs = first_absolute_sector_chs in
146
+
Ok
147
+
{
148
+
active;
149
+
first_absolute_sector_chs;
150
+
ty;
151
+
last_absolute_sector_chs;
152
+
first_absolute_sector_lba;
153
+
sectors;
154
+
}
155
+
156
+
let make' ?active ~partition_type:(ty : int) sector_start size_sectors =
157
+
if
158
+
Int64.(
159
+
logand sector_start 0xFFFF_FFFFL = sector_start
160
+
&& logand size_sectors 0xFFFF_FFFFL = size_sectors)
161
+
then
162
+
let sector_start = Int64.to_int32 sector_start in
163
+
let size_sectors = Int64.to_int32 size_sectors in
164
+
make ?active ~partition_type:ty sector_start size_sectors
165
+
else Error "partition parameters do not fit in int32"
166
+
167
+
let sizeof = 16
168
+
let status_offset = 0
169
+
let first_absolute_sector_chs_offset = 1
170
+
let ty_offset = 4
171
+
let last_absolute_sector_chs_offset = 5
172
+
let first_absolute_sector_lba_offset = 8
173
+
let sectors_offset = 12
174
+
175
+
let unmarshal buf off =
176
+
let* () =
177
+
if Bytes.length buf < off + sizeof then
178
+
Error
179
+
(Printf.sprintf "partition entry too small: %d < %d"
180
+
(Bytes.length buf - off)
181
+
sizeof)
182
+
else Ok ()
183
+
in
184
+
let ty = get_u8 buf (off + ty_offset) in
185
+
if ty == 0x00 then
186
+
if bytes_all_zero buf off sizeof then Ok None
187
+
else Error "Non-zero empty partition type"
188
+
else
189
+
let active = get_u8 buf (off + status_offset) = 0x80 in
190
+
let* first_absolute_sector_chs =
191
+
Geometry.unmarshal buf (off + first_absolute_sector_chs_offset)
192
+
in
193
+
let* last_absolute_sector_chs =
194
+
Geometry.unmarshal buf (off + last_absolute_sector_chs_offset)
195
+
in
196
+
let first_absolute_sector_lba =
197
+
get_u32_le buf (off + first_absolute_sector_lba_offset)
198
+
in
199
+
let sectors = get_u32_le buf (off + sectors_offset) in
200
+
Ok
201
+
(Some
202
+
{
203
+
active;
204
+
first_absolute_sector_chs;
205
+
ty;
206
+
last_absolute_sector_chs;
207
+
first_absolute_sector_lba;
208
+
sectors;
209
+
})
210
+
211
+
let marshal (buf : bytes) off t =
212
+
set_u8 buf (off + status_offset) (if t.active then 0x80 else 0);
213
+
set_u8 buf (off + ty_offset) t.ty;
214
+
set_u32_le buf (off + first_absolute_sector_lba_offset)
215
+
t.first_absolute_sector_lba;
216
+
set_u32_le buf (off + sectors_offset) t.sectors
217
+
end
218
+
219
+
type t = {
220
+
bootstrap_code : string;
221
+
original_physical_drive : int;
222
+
seconds : int;
223
+
minutes : int;
224
+
hours : int;
225
+
disk_signature : int32;
226
+
partitions : Partition.t list;
227
+
}
228
+
229
+
let partitions t = t.partitions
230
+
231
+
let make ?(disk_signature = 0l) partitions =
232
+
let* () =
233
+
if List.length partitions <= 4 then Ok () else Error "Too many partitions"
234
+
in
235
+
let num_active =
236
+
List.fold_left
237
+
(fun acc p -> if p.Partition.active then succ acc else acc)
238
+
0 partitions
239
+
in
240
+
let* () =
241
+
if num_active <= 1 then Ok ()
242
+
else Error "More than one active/boot partitions is not advisable"
243
+
in
244
+
let partitions =
245
+
List.sort
246
+
(fun p1 p2 ->
247
+
Int32.unsigned_compare p1.Partition.first_absolute_sector_lba
248
+
p2.Partition.first_absolute_sector_lba)
249
+
partitions
250
+
in
251
+
let* (_ : int32) =
252
+
List.fold_left
253
+
(fun r p ->
254
+
let* offset = r in
255
+
if
256
+
Int32.unsigned_compare offset p.Partition.first_absolute_sector_lba
257
+
<= 0
258
+
then
259
+
Ok
260
+
(Int32.add p.Partition.first_absolute_sector_lba p.Partition.sectors)
261
+
else Error "Partitions overlap")
262
+
(Ok 1l) partitions
263
+
in
264
+
let bootstrap_code = String.init (218 + 216) (Fun.const '\000') in
265
+
let original_physical_drive = 0 in
266
+
let seconds = 0 in
267
+
let minutes = 0 in
268
+
let hours = 0 in
269
+
Ok
270
+
{
271
+
bootstrap_code;
272
+
original_physical_drive;
273
+
seconds;
274
+
minutes;
275
+
hours;
276
+
disk_signature;
277
+
partitions;
278
+
}
279
+
280
+
(* MBR layout constants *)
281
+
let sizeof = 512
282
+
let bootstrap_code1_offset = 0
283
+
let bootstrap_code1_len = 218
284
+
let original_physical_drive_offset = 220
285
+
let seconds_offset = 221
286
+
let minutes_offset = 222
287
+
let hours_offset = 223
288
+
let bootstrap_code2_offset = 224
289
+
let bootstrap_code2_len = 216
290
+
let disk_signature_offset = 440
291
+
let partitions_offset = 446
292
+
let signature1_offset = 510
293
+
let signature2_offset = 511
294
+
295
+
let partition_offset n =
296
+
assert (n >= 0 && n < 4);
297
+
partitions_offset + (n * Partition.sizeof)
298
+
299
+
let default_partition_start = 2048l
300
+
301
+
(* Internal unmarshal from bytes buffer *)
302
+
let unmarshal_bytes (buf : bytes) : (t, string) result =
303
+
let* () =
304
+
if Bytes.length buf < sizeof then
305
+
Error (Printf.sprintf "MBR too small: %d < %d" (Bytes.length buf) sizeof)
306
+
else Ok ()
307
+
in
308
+
let signature1 = get_u8 buf signature1_offset in
309
+
let signature2 = get_u8 buf signature2_offset in
310
+
let* () =
311
+
if signature1 = 0x55 && signature2 = 0xaa then Ok ()
312
+
else
313
+
Error
314
+
(Printf.sprintf "Invalid signature: %02x %02x <> 0x55 0xaa" signature1
315
+
signature2)
316
+
in
317
+
let bootstrap_code =
318
+
Bytes.sub_string buf bootstrap_code1_offset bootstrap_code1_len
319
+
^ Bytes.sub_string buf bootstrap_code2_offset bootstrap_code2_len
320
+
in
321
+
let original_physical_drive = get_u8 buf original_physical_drive_offset in
322
+
let seconds = get_u8 buf seconds_offset in
323
+
let minutes = get_u8 buf minutes_offset in
324
+
let hours = get_u8 buf hours_offset in
325
+
let disk_signature = get_u32_le buf disk_signature_offset in
326
+
let* p1 = Partition.unmarshal buf (partition_offset 0) in
327
+
let* p2 = Partition.unmarshal buf (partition_offset 1) in
328
+
let* p3 = Partition.unmarshal buf (partition_offset 2) in
329
+
let* p4 = Partition.unmarshal buf (partition_offset 3) in
330
+
let partitions = List.filter_map Fun.id [ p1; p2; p3; p4 ] in
331
+
Ok
332
+
{
333
+
bootstrap_code;
334
+
original_physical_drive;
335
+
seconds;
336
+
minutes;
337
+
hours;
338
+
disk_signature;
339
+
partitions;
340
+
}
341
+
342
+
(* Internal marshal to bytes buffer *)
343
+
let marshal_bytes (buf : bytes) t =
344
+
Bytes.blit_string t.bootstrap_code 0 buf bootstrap_code1_offset
345
+
bootstrap_code1_len;
346
+
Bytes.blit_string t.bootstrap_code bootstrap_code1_len buf
347
+
bootstrap_code2_offset bootstrap_code2_len;
348
+
set_u8 buf original_physical_drive_offset t.original_physical_drive;
349
+
set_u8 buf seconds_offset t.seconds;
350
+
set_u8 buf minutes_offset t.minutes;
351
+
set_u8 buf hours_offset t.hours;
352
+
set_u32_le buf disk_signature_offset t.disk_signature;
353
+
List.iteri
354
+
(fun i p -> Partition.marshal buf (partition_offset i) p)
355
+
t.partitions;
356
+
set_u8 buf signature1_offset 0x55;
357
+
set_u8 buf signature2_offset 0xaa
358
+
359
+
(* Streaming API *)
360
+
361
+
let of_string s = unmarshal_bytes (Bytes.of_string s)
362
+
363
+
let to_string t =
364
+
let buf = Bytes.create sizeof in
365
+
marshal_bytes buf t;
366
+
Bytes.to_string buf
367
+
368
+
let read reader =
369
+
match read_exactly reader sizeof with
370
+
| Error e -> Error e
371
+
| Ok buf -> unmarshal_bytes buf
372
+
373
+
let write writer t =
374
+
let s = to_string t in
375
+
Writer.write writer (Slice.of_string s)
+117
lib/mbr.mli
+117
lib/mbr.mli
···
1
+
(*
2
+
* Copyright (C) 2013 Citrix Inc
3
+
*
4
+
* Permission to use, copy, modify, and distribute this software for any
5
+
* purpose with or without fee is hereby granted, provided that the above
6
+
* copyright notice and this permission notice appear in all copies.
7
+
*
8
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
+
*)
16
+
17
+
(** MBR (Master Boot Record) partition table format. *)
18
+
19
+
module Geometry : sig
20
+
type t = { cylinders : int; heads : int; sectors : int }
21
+
(** Represents a sector address using the cylinder-heads-sectors addressing
22
+
scheme. *)
23
+
24
+
val of_lba_size : int64 -> (t, string) result
25
+
(** For LBA addressable disks of < 8GiB, synthesise a plausible geometry given
26
+
a total number of sectors. *)
27
+
28
+
val to_chs : t -> int64 -> t
29
+
(** Given a geometry and an LBA offset, compute the CHS of the offset. *)
30
+
end
31
+
32
+
module Partition : sig
33
+
type t = private {
34
+
active : bool;
35
+
(** true means the partition is active, also known as bootable *)
36
+
first_absolute_sector_chs : Geometry.t;
37
+
(** the CHS address of the first data sector. This is only used by
38
+
BIOSes with pre-LBA disks (< 1996). This will not be marshalled. *)
39
+
ty : int; (** the advertised filesystem type *)
40
+
last_absolute_sector_chs : Geometry.t;
41
+
(** the CHS address of the last data sector. This is only used by BIOSes
42
+
with pre-LBA disks (< 1996). This will not be marshalled. *)
43
+
first_absolute_sector_lba : int32;
44
+
(** the Logical Block Address (LBA) of the first data sector. This is
45
+
the absolute sector offset of the first data sector. *)
46
+
sectors : int32; (** the total number of sectors in the partition *)
47
+
}
48
+
(** A primary partition within the partition table. *)
49
+
50
+
val sector_start : t -> int64
51
+
(** [sector_start t] is the int64 representation of
52
+
[t.first_absolute_sector_lba]. *)
53
+
54
+
val size_sectors : t -> int64
55
+
(** [size_sectors t] is the int64 representation of [t.sectors]. *)
56
+
57
+
val make :
58
+
?active:bool -> partition_type:int -> int32 -> int32 -> (t, string) result
59
+
(** [make ?active ~partition_type start length] creates a partition starting
60
+
at sector [start] and with length [length] sectors. If the active flag is
61
+
set then the partition will be marked as active/bootable. Partition type
62
+
[ty] determines the advertised filesystem type. [ty] must be between 1 and
63
+
255. *)
64
+
65
+
val make' :
66
+
?active:bool -> partition_type:int -> int64 -> int64 -> (t, string) result
67
+
(** [make' ?active ~partition_type sector_start size_sectors] is
68
+
[make ?active ~partition_type (Int64.to_int32 sector_start)
69
+
(Int64.to_int32 size_sectors)] when both [sector_start] and [size_sectors]
70
+
fit in int32. Otherwise [Error _]. *)
71
+
end
72
+
73
+
type t = private {
74
+
bootstrap_code : string;
75
+
original_physical_drive : int;
76
+
seconds : int;
77
+
minutes : int;
78
+
hours : int;
79
+
disk_signature : int32;
80
+
partitions : Partition.t list;
81
+
}
82
+
(** An MBR record. *)
83
+
84
+
val make : ?disk_signature:int32 -> Partition.t list -> (t, string) result
85
+
(** [make ?disk_signature partitions] constructs an MBR given a desired list of
86
+
primary partitions. An [Error _] is returned if:
87
+
88
+
- The number of partitions exceeds four,
89
+
- Any of the partitions overlap with each other or the first sector,
90
+
- More than one partition is marked as active (bootable).
91
+
92
+
The optional argument [disk_signature] specifies the disk signature to be
93
+
written in the MBR. If [disk_signature] is not provided, the default value
94
+
of [0l] is used. *)
95
+
96
+
val partitions : t -> Partition.t list
97
+
(** [partitions t] returns the list of partitions in the MBR. *)
98
+
99
+
val sizeof : int
100
+
(** [sizeof] is the size of a master boot record in bytes (512 bytes). *)
101
+
102
+
val default_partition_start : int32
103
+
(** Default sector offset for first partition. *)
104
+
105
+
(** {1 Streaming API} *)
106
+
107
+
val of_string : string -> (t, string) result
108
+
(** [of_string s] parses an MBR from a string. *)
109
+
110
+
val to_string : t -> string
111
+
(** [to_string t] serializes an MBR to a string. *)
112
+
113
+
val read : Bytesrw.Bytes.Reader.t -> (t, string) result
114
+
(** [read reader] reads an MBR from a bytesrw reader. *)
115
+
116
+
val write : Bytesrw.Bytes.Writer.t -> t -> unit
117
+
(** [write writer t] writes an MBR to a bytesrw writer. *)
+36
mbr-format.opam
+36
mbr-format.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "A library to manipulate Master Boot Records"
4
+
description: """
5
+
Pure OCaml library for reading and writing Master Boot Records (MBR).
6
+
Useful for creating bootable disk images and reading partition tables."""
7
+
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
8
+
authors: [
9
+
"David Scott <dave.scott@eu.citrix.com>"
10
+
"Reynir Björnsson <reynir@reynir.dk>"
11
+
]
12
+
license: "ISC"
13
+
bug-reports: "https://tangled.org/gazagnaire.org/ocaml-mbr/issues"
14
+
depends: [
15
+
"dune" {>= "3.17"}
16
+
"ocaml" {>= "5.1"}
17
+
"bytesrw" {>= "0.1"}
18
+
"alcotest" {with-test}
19
+
"crowbar" {with-test}
20
+
"odoc" {with-doc}
21
+
]
22
+
build: [
23
+
["dune" "subst"] {dev}
24
+
[
25
+
"dune"
26
+
"build"
27
+
"-p"
28
+
name
29
+
"-j"
30
+
jobs
31
+
"@install"
32
+
"@runtest" {with-test}
33
+
"@doc" {with-doc}
34
+
]
35
+
]
36
+
dev-repo: "https://tangled.org/gazagnaire.org/ocaml-mbr"
+123
test/test_mbr.ml
+123
test/test_mbr.ml
···
1
+
let ( let* ) = Result.bind
2
+
3
+
let get_ok = function
4
+
| Ok x -> x
5
+
| Error s -> Alcotest.failf "expected Ok, got Error \"%S\"" s
6
+
7
+
module Testable_partition = struct
8
+
let pp_geometry ppf { Mbr.Geometry.cylinders; heads; sectors } =
9
+
Fmt.pf ppf "{ cylinders = %d; heads = %d; sectors = %d }" cylinders heads
10
+
sectors
11
+
12
+
let pp ppf
13
+
{
14
+
Mbr.Partition.active;
15
+
first_absolute_sector_chs;
16
+
ty;
17
+
last_absolute_sector_chs;
18
+
first_absolute_sector_lba;
19
+
sectors;
20
+
} =
21
+
Fmt.pf ppf
22
+
"{ active = %b; first_absolute_sector_chs = %a; ty = %d; \
23
+
last_absolute_sector_chs = %a; first_absolute_sector_lba = %lu; sectors \
24
+
= %lu }"
25
+
active pp_geometry first_absolute_sector_chs ty pp_geometry
26
+
last_absolute_sector_chs first_absolute_sector_lba sectors
27
+
28
+
type t = Mbr.Partition.t
29
+
30
+
let equal = ( = ) (* :/ *)
31
+
end
32
+
33
+
let partition =
34
+
(module Testable_partition : Alcotest.TESTABLE with type t = Mbr.Partition.t)
35
+
36
+
let test_partition_make () =
37
+
ignore
38
+
(get_ok
39
+
(Mbr.Partition.make ~partition_type:6 Mbr.default_partition_start 2048l))
40
+
41
+
let test_partition_make_ty_0 () =
42
+
match Mbr.Partition.make ~partition_type:0 Mbr.default_partition_start 0l with
43
+
| Error _ -> ()
44
+
| Ok _ -> Alcotest.fail "expected Error"
45
+
46
+
let test_partition_make_ty_256 () =
47
+
match
48
+
Mbr.Partition.make ~partition_type:256 Mbr.default_partition_start 0l
49
+
with
50
+
| Error _ -> ()
51
+
| Ok _ -> Alcotest.fail "expected Error"
52
+
53
+
let suite_partition_make =
54
+
[
55
+
("Partition.make ok", `Quick, test_partition_make);
56
+
("Partition.make ~partition_type:0", `Quick, test_partition_make_ty_0);
57
+
("Partition.make ~partition_type:256", `Quick, test_partition_make_ty_256);
58
+
]
59
+
60
+
let test_make_empty () =
61
+
match Mbr.make [] with
62
+
| Ok _ -> ()
63
+
| Error e -> Alcotest.failf "expected Ok, got %s" e
64
+
65
+
let test_make_too_many_partitions () =
66
+
let r =
67
+
let* p1 =
68
+
Mbr.Partition.make ~partition_type:6 Mbr.default_partition_start 1l
69
+
in
70
+
let* p2 =
71
+
Mbr.Partition.make ~partition_type:6
72
+
(Int32.add Mbr.default_partition_start 1l)
73
+
1l
74
+
in
75
+
let* p3 =
76
+
Mbr.Partition.make ~partition_type:6
77
+
(Int32.add Mbr.default_partition_start 2l)
78
+
1l
79
+
in
80
+
let* p4 =
81
+
Mbr.Partition.make ~partition_type:6
82
+
(Int32.add Mbr.default_partition_start 3l)
83
+
1l
84
+
in
85
+
let* p5 =
86
+
Mbr.Partition.make ~partition_type:6
87
+
(Int32.add Mbr.default_partition_start 4l)
88
+
1l
89
+
in
90
+
Ok [ p1; p2; p3; p4; p5 ]
91
+
in
92
+
let ps = get_ok r in
93
+
match Mbr.make ps with
94
+
| Ok _ -> Alcotest.fail "expected Error"
95
+
| Error _ -> ()
96
+
97
+
let test_make_overlapping () =
98
+
let p1 = get_ok (Mbr.Partition.make ~partition_type:6 10l 10l) in
99
+
let p2 = get_ok (Mbr.Partition.make ~partition_type:6 15l 10l) in
100
+
match (Mbr.make [ p1; p2 ], Mbr.make [ p2; p1 ]) with
101
+
| Ok _, _ | _, Ok _ -> Alcotest.fail "expected Error"
102
+
| Error _, Error _ -> ()
103
+
104
+
let test_make_sorted () =
105
+
let p1 = get_ok (Mbr.Partition.make ~partition_type:6 10l 1l) in
106
+
let p2 = get_ok (Mbr.Partition.make ~partition_type:6 11l 1l) in
107
+
let m1 = get_ok (Mbr.make [ p1; p2 ]) in
108
+
let m2 = get_ok (Mbr.make [ p2; p1 ]) in
109
+
(* polymorphic compare :'( *)
110
+
Alcotest.(
111
+
check (list partition) "partitions equal" m1.partitions m2.partitions)
112
+
113
+
let suite_make =
114
+
[
115
+
("make []", `Quick, test_make_empty);
116
+
("make with 5 partitions", `Quick, test_make_too_many_partitions);
117
+
("make with overlapping partitions", `Quick, test_make_overlapping);
118
+
("make sorts partitions", `Quick, test_make_sorted);
119
+
]
120
+
121
+
let () =
122
+
Alcotest.run "Mbr"
123
+
[ ("Mbr.Partition.make", suite_partition_make); ("Mbr.make", suite_make) ]