Script to create an MBR formatted disk.

README.md

@@ -35,3 +35,4 @@ To do items
 * Implement tools to manipulate MBR-formatted disk images
   to construct, inspect or fill partitions that can later
   be used in Mirage unikernels.
+

bin/create_mbr_disk.ml

@@ -0,0 +1,79 @@
+open Cmdliner
+
+let create_mbr_disk destination partition_files =
+  let sector_size = Mbr.sizeof in
+  let num_partitions = List.length partition_files in
+  if num_partitions > 4 then (
+    Printf.printf
+      "Too many partition files. Limit number of files to 4 as MBR supports at \
+       most 4 partitions";
+    exit 1)
+  else (
+    Printf.printf "Total partitions to create: %d\n" num_partitions;
+    let partition_sizes =
+      List.map (fun file -> (Unix.stat file).Unix.st_size) partition_files
+    in
+
+    let partition_size = List.fold_left ( + ) 0 partition_sizes in
+    let mbr_size = Mbr.sizeof in
+    let total_size = partition_size + mbr_size in
+
+    let partitions =
+      List.mapi
+        (fun i size ->
+          if size mod 512 <> 0 then (
+            Printf.eprintf
+              "Partition %d will contain data that can't fill up the partiton. \
+               The data should have a size which is a multiple of %d\n"
+              (i + 1) mbr_size;
+            exit 1)
+          else Printf.printf "Creating partition: %d" (i + 1);
+          let start_sector = (i + 1) * sector_size in
+          let num_sectors = (size + sector_size - 1) / sector_size in
+          match
+            Mbr.Partition.make ~active:false ~partition_type:6
+              (Int32.of_int start_sector)
+              (Int32.of_int num_sectors)
+          with
+          | Ok partition ->
+              Printf.printf " - OK\n";
+              partition
+          | Error msg ->
+              Printf.printf "Failed to create MBR: %s" msg;
+              exit 1)
+        partition_sizes
+    in
+
+    (* Mbr.make smart constructor checks for partition overlap, more than 1 active partitions and too many partitions *)
+    let mbr =
+      match Mbr.make partitions with
+      | Ok mbr -> mbr
+      | Error msg ->
+          Printf.printf "Failed to create MBR: %s" msg;
+          exit 1
+    in
+    let oc = open_out_bin destination in
+    let mbr_buffer = Cstruct.create Mbr.sizeof in
+    Mbr.marshal mbr_buffer mbr;
+    output oc (Cstruct.to_bytes mbr_buffer) 0 Mbr.sizeof;
+    close_out oc;
+    Unix.truncate destination total_size)
+
+let destination =
+  let doc = "Output file for the MBR formatted disk image" in
+  Arg.(
+    required
+    & opt (some string) None
+    & info [ "d"; "destination" ] ~docv:"destination" ~doc)
+
+let partition_files =
+  let doc = "Data files to be written to the partitions" in
+  Arg.(value & pos_all file [] & info [] ~docv:"partition_files" ~doc)
+
+let cmd =
+  let doc = "Create an MBR formatted disk image with an MBR header." in
+  let info = Cmd.info "create_mbr_disk" ~version:"1.0.0" ~doc in
+  Cmd.v info Term.(const create_mbr_disk $ destination $ partition_files)
+
+let main () = exit (Cmd.eval cmd)
+let () = main ()

bin/dune

@@ -1,3 +1,8 @@
 (executables
- (names mbr_inspect read_partition write_partition resize_partition)
+ (names
+  mbr_inspect
+  read_partition
+  write_partition
+  resize_partition
+  create_mbr_disk)
  (libraries mbr cstruct cmdliner unix))

bin/mbr_inspect.ml

@@ -11,6 +11,18 @@ let print_mbr_fields print_bootstrap_code mbr =
   Printf.printf "  minutes: %d\n" mbr.Mbr.minutes;
   Printf.printf "  hours: %d\n" mbr.Mbr.hours;
   Printf.printf "  disk_signature: %lx\n" mbr.Mbr.disk_signature;
+  let total_disk_size =
+    List.fold_left
+      (fun acc part ->
+        let partition_size =
+          Int64.mul
+            (Int64.of_int32 part.Mbr.Partition.sectors)
+            (Int64.of_int Mbr.sizeof)
+        in
+        Int64.add acc partition_size)
+      Int64.zero mbr.partitions
+  in
+  Printf.printf "  disk_size: %Ld bytes\n" total_disk_size;
   List.iteri
     (fun i part ->
       let chs_begin = part.Mbr.Partition.first_absolute_sector_chs in
@@ -30,7 +42,13 @@ let print_mbr_fields print_bootstrap_code mbr =
         cylinders heads sectors;
       Printf.printf "    lba_begin: %ld\n"
         part.Mbr.Partition.first_absolute_sector_lba;
-      Printf.printf "    size_sectors: %ld\n" part.Mbr.Partition.sectors)
+      Printf.printf "    size_sectors: %ld\n" part.Mbr.Partition.sectors;
+      let partition_size =
+        Int64.mul
+          (Int64.of_int32 part.Mbr.Partition.sectors)
+          (Int64.of_int Mbr.sizeof)
+      in
+      Printf.printf "    partition_size: %Ld bytes\n" partition_size)
     mbr.partitions
 
 let read_mbrs print_bootstrap_code mbrs =