├── .gitignore ├── .ocamlformat ├── CHANGES.md ├── LICENSE ├── README.md ├── bin ├── dune ├── mbr_inspect.ml ├── read_partition.ml ├── resize_partition.ml └── write_partition.ml ├── dune-project ├── lib ├── dune ├── mbr.ml └── mbr.mli ├── mbr-format.opam └── test ├── dune └── test_mbr.ml /.gitignore: -------------------------------------------------------------------------------- 1 | *.annot 2 | *.cmo 3 | *.cma 4 | *.cmi 5 | *.a 6 | *.o 7 | *.cmx 8 | *.cmxs 9 | *.cmxa 10 | _build 11 | setup.* 12 | main.native 13 | test.native 14 | .vscode -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | version = 0.24.1 2 | profile = conventional 3 | break-infix = fit-or-vertical 4 | parse-docstrings = true 5 | -------------------------------------------------------------------------------- /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]`` 27 | -------------------------------------------------------------------------------- /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 | 15 | -------------------------------------------------------------------------------- /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. 38 | -------------------------------------------------------------------------------- /bin/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names mbr_inspect read_partition write_partition resize_partition) 3 | (libraries mbr cstruct cmdliner unix)) 4 | -------------------------------------------------------------------------------- /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 () 65 | -------------------------------------------------------------------------------- /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 () 89 | -------------------------------------------------------------------------------- /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 () 101 | -------------------------------------------------------------------------------- /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 () 96 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.4) 2 | (name mbr-format) 3 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name mbr-format) 3 | (name mbr) 4 | (libraries cstruct) 5 | (modules mbr)) 6 | -------------------------------------------------------------------------------- /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 | let ( >>= ) = Result.bind 18 | 19 | module Geometry = struct 20 | type t = { cylinders : int; heads : int; sectors : int } 21 | 22 | let kib = 1024L 23 | let mib = Int64.mul kib 1024L 24 | let sizeof = 3 25 | 26 | let unmarshal buf : (t, _) result = 27 | (if Cstruct.length buf < sizeof then 28 | Error 29 | (Printf.sprintf "geometry too small: %d < %d" (Cstruct.length buf) sizeof) 30 | else Ok ()) 31 | >>= fun () -> 32 | let heads = Cstruct.get_uint8 buf 0 in 33 | let y = Cstruct.get_uint8 buf 1 in 34 | let z = Cstruct.get_uint8 buf 2 in 35 | let sectors = y land 0b0111111 in 36 | let cylinders = (y lsl 2) lor z in 37 | Ok { cylinders; heads; sectors } 38 | 39 | let of_lba_size x = 40 | let sectors = 63 in 41 | (if x < Int64.(mul 504L mib) then Ok 16 42 | else if x < Int64.(mul 1008L mib) then Ok 64 43 | else if x < Int64.(mul 4032L mib) then Ok 128 44 | else if x < Int64.(add (mul 8032L mib) (mul 512L kib)) then Ok 255 45 | else Error (Printf.sprintf "sector count exceeds LBA max: %Ld" x)) 46 | >>= fun heads -> 47 | let cylinders = 48 | Int64.(to_int (div (div x (of_int sectors)) (of_int heads))) 49 | in 50 | Ok { cylinders; heads; sectors } 51 | 52 | let to_chs g x = 53 | let open Int64 in 54 | let cylinders = to_int (div x (mul (of_int g.sectors) (of_int g.heads))) in 55 | let heads = to_int (rem (div x (of_int g.sectors)) (of_int g.heads)) in 56 | let sectors = to_int (succ (rem x (of_int g.sectors))) in 57 | { cylinders; heads; sectors } 58 | end 59 | 60 | module Partition = struct 61 | type t = { 62 | active : bool; 63 | first_absolute_sector_chs : Geometry.t; 64 | ty : int; 65 | last_absolute_sector_chs : Geometry.t; 66 | first_absolute_sector_lba : int32; 67 | sectors : int32; 68 | } 69 | 70 | let sector_start t = 71 | Int64.(logand (of_int32 t.first_absolute_sector_lba) 0xFFFF_FFFFL) 72 | 73 | let size_sectors t = Int64.(logand (of_int32 t.sectors) 0xFFFF_FFFFL) 74 | 75 | let make ?(active = false) ~partition_type:(ty : int) 76 | first_absolute_sector_lba sectors = 77 | (* ty has to fit in a uint8_t, and ty=0 is reserved for empty partition entries *) 78 | (if ty > 0 && ty < 256 then Ok () 79 | else Error "Mbr.Partition.make: ty must be between 1 and 255") 80 | >>= fun () -> 81 | let first_absolute_sector_chs = 82 | { Geometry.cylinders = 0; heads = 0; sectors = 0 } 83 | in 84 | let last_absolute_sector_chs = first_absolute_sector_chs in 85 | Ok 86 | { 87 | active; 88 | first_absolute_sector_chs; 89 | ty; 90 | last_absolute_sector_chs; 91 | first_absolute_sector_lba; 92 | sectors; 93 | } 94 | 95 | let make' ?active ~partition_type:(ty : int) sector_start size_sectors = 96 | if 97 | Int64.( 98 | logand sector_start 0xFFFF_FFFFL = sector_start 99 | && logand size_sectors 0xFFFF_FFFFL = size_sectors) 100 | then 101 | let sector_start = Int64.to_int32 sector_start in 102 | let size_sectors = Int64.to_int32 size_sectors in 103 | make ?active ~partition_type:ty sector_start size_sectors 104 | else Error "partition parameters do not fit in int32" 105 | 106 | let sizeof = 16 107 | let status_offset = 0 108 | let first_absolute_sector_chs_offset = 1 109 | let ty_offset = 4 110 | let last_absolute_sector_chs_offset = 5 111 | let first_absolute_sector_lba_offset = 8 112 | let sectors_offset = 12 113 | 114 | let unmarshal buf = 115 | (if Cstruct.length buf < sizeof then 116 | Error 117 | (Printf.sprintf "partition entry too small: %d < %d" (Cstruct.length buf) 118 | sizeof) 119 | else Ok ()) 120 | >>= fun () -> 121 | let buf = Cstruct.sub buf 0 sizeof in 122 | let ty = Cstruct.get_uint8 buf ty_offset in 123 | if ty == 0x00 then 124 | if Cstruct.for_all (( = ) '\000') buf then Ok None 125 | else Error "Non-zero empty partition type" 126 | else 127 | let active = Cstruct.get_uint8 buf status_offset = 0x80 in 128 | Geometry.unmarshal 129 | (Cstruct.sub buf first_absolute_sector_chs_offset Geometry.sizeof) 130 | >>= fun first_absolute_sector_chs -> 131 | Geometry.unmarshal 132 | (Cstruct.sub buf last_absolute_sector_chs_offset Geometry.sizeof) 133 | >>= fun last_absolute_sector_chs -> 134 | let first_absolute_sector_lba = 135 | Cstruct.LE.get_uint32 buf first_absolute_sector_lba_offset 136 | in 137 | let sectors = Cstruct.LE.get_uint32 buf sectors_offset in 138 | Ok 139 | (Some 140 | { 141 | active; 142 | first_absolute_sector_chs; 143 | ty; 144 | last_absolute_sector_chs; 145 | first_absolute_sector_lba; 146 | sectors; 147 | }) 148 | 149 | let marshal (buf : Cstruct.t) t = 150 | Cstruct.set_uint8 buf status_offset (if t.active then 0x80 else 0); 151 | Cstruct.set_uint8 buf ty_offset t.ty; 152 | Cstruct.LE.set_uint32 buf first_absolute_sector_lba_offset 153 | t.first_absolute_sector_lba; 154 | Cstruct.LE.set_uint32 buf sectors_offset t.sectors 155 | end 156 | 157 | type t = { 158 | bootstrap_code : string; 159 | original_physical_drive : int; 160 | seconds : int; 161 | minutes : int; 162 | hours : int; 163 | disk_signature : int32; 164 | partitions : Partition.t list; 165 | } 166 | 167 | let make ?(disk_signature = 0l) partitions = 168 | (if List.length partitions <= 4 then Ok () else Error "Too many partitions") 169 | >>= fun () -> 170 | let num_active = 171 | List.fold_left 172 | (fun acc p -> if p.Partition.active then succ acc else acc) 173 | 0 partitions 174 | in 175 | (if num_active <= 1 then Ok () 176 | else Error "More than one active/boot partitions is not advisable") 177 | >>= fun () -> 178 | let partitions = 179 | List.sort 180 | (fun p1 p2 -> 181 | Int32.unsigned_compare p1.Partition.first_absolute_sector_lba 182 | p2.Partition.first_absolute_sector_lba) 183 | partitions 184 | in 185 | (* Check for overlapping partitions *) 186 | List.fold_left 187 | (fun r p -> 188 | r >>= fun offset -> 189 | if 190 | Int32.unsigned_compare offset p.Partition.first_absolute_sector_lba <= 0 191 | then 192 | Ok (Int32.add p.Partition.first_absolute_sector_lba p.Partition.sectors) 193 | else Error "Partitions overlap") 194 | (Ok 1l) (* We start at 1 so the partitions don't overlap with the MBR *) 195 | partitions 196 | >>= fun (_ : int32) -> 197 | let bootstrap_code = String.init (218 + 216) (Fun.const '\000') in 198 | let original_physical_drive = 0 in 199 | let seconds = 0 in 200 | let minutes = 0 in 201 | let hours = 0 in 202 | 203 | Ok 204 | { 205 | bootstrap_code; 206 | original_physical_drive; 207 | seconds; 208 | minutes; 209 | hours; 210 | disk_signature; 211 | partitions; 212 | } 213 | 214 | (* "modern standard" MBR from wikipedia: *) 215 | let sizeof_mbr = 512 216 | let bootstrap_code1_offset = 0 217 | let bootstrap_code1_len = 218 218 | let _zeroes_1_offset = 218 219 | let _zeroes_1_len = 2 220 | let original_physical_drive_offset = 220 221 | let seconds_offset = 221 222 | let minutes_offset = 222 223 | let hours_offset = 223 224 | let bootstrap_code2_offset = 224 225 | let bootstrap_code2_len = 216 226 | let disk_signature_offset = 440 227 | let _zeroes_2_offset = 444 (* also copy-protected *) 228 | let _zeroes_2_len = 2 229 | let partitions_offset = 446 230 | 231 | let partition_offset n = 232 | assert (n >= 0 && n < 4); 233 | partitions_offset + (n * Partition.sizeof) 234 | 235 | let signature1_offset = 510 236 | let signature2_offset = 511 237 | 238 | let unmarshal (buf : Cstruct.t) : (t, string) result = 239 | (if Cstruct.length buf < sizeof_mbr then 240 | Error 241 | (Printf.sprintf "MBR too small: %d < %d" (Cstruct.length buf) sizeof_mbr) 242 | else Ok ()) 243 | >>= fun () -> 244 | let signature1 = Cstruct.get_uint8 buf signature1_offset in 245 | let signature2 = Cstruct.get_uint8 buf signature2_offset in 246 | (if signature1 = 0x55 && signature2 = 0xaa then Ok () 247 | else 248 | Error 249 | (Printf.sprintf "Invalid signature: %02x %02x <> 0x55 0xaa" signature1 250 | signature2)) 251 | >>= fun () -> 252 | let bootstrap_code = 253 | Cstruct.copyv 254 | [ 255 | Cstruct.sub buf bootstrap_code1_offset bootstrap_code1_len; 256 | Cstruct.sub buf bootstrap_code2_offset bootstrap_code2_len; 257 | ] 258 | in 259 | let original_physical_drive = 260 | Cstruct.get_uint8 buf original_physical_drive_offset 261 | in 262 | let seconds = Cstruct.get_uint8 buf seconds_offset in 263 | let minutes = Cstruct.get_uint8 buf minutes_offset in 264 | let hours = Cstruct.get_uint8 buf hours_offset in 265 | let disk_signature = Cstruct.LE.get_uint32 buf disk_signature_offset in 266 | Partition.unmarshal (Cstruct.sub buf (partition_offset 0) Partition.sizeof) 267 | >>= fun p1 -> 268 | Partition.unmarshal (Cstruct.sub buf (partition_offset 1) Partition.sizeof) 269 | >>= fun p2 -> 270 | Partition.unmarshal (Cstruct.sub buf (partition_offset 2) Partition.sizeof) 271 | >>= fun p3 -> 272 | Partition.unmarshal (Cstruct.sub buf (partition_offset 3) Partition.sizeof) 273 | >>= fun p4 -> 274 | let partitions = List.filter_map Fun.id [ p1; p2; p3; p4 ] in 275 | Ok 276 | { 277 | bootstrap_code; 278 | original_physical_drive; 279 | seconds; 280 | minutes; 281 | hours; 282 | disk_signature; 283 | partitions; 284 | } 285 | 286 | let marshal (buf : Cstruct.t) t = 287 | Cstruct.blit_from_string t.bootstrap_code 0 buf bootstrap_code1_offset 288 | bootstrap_code1_len; 289 | Cstruct.blit_from_string t.bootstrap_code bootstrap_code1_len buf 290 | bootstrap_code2_offset bootstrap_code2_len; 291 | Cstruct.set_uint8 buf original_physical_drive_offset t.original_physical_drive; 292 | Cstruct.set_uint8 buf seconds_offset t.seconds; 293 | Cstruct.set_uint8 buf minutes_offset t.minutes; 294 | Cstruct.set_uint8 buf hours_offset t.hours; 295 | Cstruct.LE.set_uint32 buf disk_signature_offset t.disk_signature; 296 | List.iteri 297 | (fun i p -> 298 | Partition.marshal 299 | (Cstruct.sub buf (partition_offset i) Partition.sizeof) 300 | p) 301 | t.partitions; 302 | Cstruct.set_uint8 buf signature1_offset 0x55; 303 | Cstruct.set_uint8 buf signature2_offset 0xaa 304 | 305 | let sizeof = sizeof_mbr 306 | let default_partition_start = 2048l 307 | -------------------------------------------------------------------------------- /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 | module Geometry : sig 18 | type t = { cylinders : int; heads : int; sectors : int } 19 | (** Represents a sector address using the cylinder-heads-sectors addressing 20 | scheme. *) 21 | 22 | val unmarshal : Cstruct.t -> (t, string) result 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 69 | (Int64.to_int32 sector_start) (Int64.to_int32 size_sectors)] 70 | when both [sector_start] and [size_sectors] fit in int32. Otherwise 71 | [Error _]. *) 72 | 73 | val unmarshal : Cstruct.t -> (t option, string) result 74 | (** [unmarshal buf] is the partition entry encoded in the beginning of [buf]. 75 | If it is the empty partition entry [None] is returned. *) 76 | end 77 | 78 | type t = private { 79 | bootstrap_code : string; 80 | original_physical_drive : int; 81 | seconds : int; 82 | minutes : int; 83 | hours : int; 84 | disk_signature : int32; 85 | partitions : Partition.t list; 86 | } 87 | 88 | val make : ?disk_signature:int32 -> Partition.t list -> (t, string) result 89 | 90 | (** [make ?disk_signature partitions] constructs an MBR given a desired list of 91 | primary partitions. An [Error _] is returned if: 92 | 93 | - The number of partitions exceeds four, 94 | - Any of the partitions overlap with each other or the first sector, 95 | - More than one partition is marked as active (bootable). 96 | 97 | The optional argument [disk_signature] specifies the disk signature to be 98 | written in the MBR. If [disk_signature] is not provided, the default value 99 | of [0l] is used. *) 100 | 101 | val marshal : Cstruct.t -> t -> unit 102 | val unmarshal : Cstruct.t -> (t, string) result 103 | 104 | val sizeof : int 105 | (** [sizeof] is the size of a master boot record in bytes (512 bytes) *) 106 | 107 | val default_partition_start : int32 108 | (** default sector offset for first partition *) 109 | -------------------------------------------------------------------------------- /mbr-format.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: ["Reynir Björnsson " "dave.scott@eu.citrix.com"] 3 | authors: "dave.scott@eu.citrix.com" 4 | license: "ISC" 5 | homepage: "https://github.com/mirage/ocaml-mbr" 6 | bug-reports: "https://github.com/mirage/ocaml-mbr/issues" 7 | dev-repo: "git+https://github.com/mirage/ocaml-mbr.git" 8 | build: [ 9 | ["dune" "subst"] {dev} 10 | ["dune" "build" "-p" name "-j" jobs] 11 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 12 | ] 13 | depends: [ 14 | "ocaml" {>= "4.08.0"} 15 | "dune" {>= "3.4.0"} 16 | "cstruct" {>= "6.0.0"} 17 | "cstruct" {dev & >= "6.2.0"} 18 | "fmt" {with-test} 19 | "alcotest" {with-test} 20 | ] 21 | conflicts: [ 22 | "result" {< "1.5"} 23 | ] 24 | synopsis: "A library for manipulating Master Boot Records" 25 | x-maintenance-intent: [ "(latest)" ] 26 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name test_mbr) 3 | (libraries mbr alcotest fmt)) 4 | -------------------------------------------------------------------------------- /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) ] 124 | --------------------------------------------------------------------------------