From c5e091a29474c414d483be034fe72b2a1fb00cd9 Mon Sep 17 00:00:00 2001
From: Hannes Mehnert <hannes@mehnert.org>
Date: Thu, 21 Nov 2024 12:11:48 +0100
Subject: [PATCH] specify sizes of partitions in MB, not in sectors

---
 mirage/partitions.ml | 18 ++++++++++++++----
 mirage/unikernel.ml  | 32 ++++++++++++++++----------------
 2 files changed, 30 insertions(+), 20 deletions(-)

diff --git a/mirage/partitions.ml b/mirage/partitions.ml
index 575f79b..b655c2a 100644
--- a/mirage/partitions.ml
+++ b/mirage/partitions.ml
@@ -101,7 +101,7 @@ module Make(BLOCK : Mirage_block.S) = struct
     and md5s = get_part md5s and sha512s = get_part sha512s in
     { tar ; swap; git_dump ; md5s ; sha512s }
 
-  let format block ~sectors_cache ~sectors_git ~sectors_swap =
+  let format block ~cache_size ~git_size ~swap_size =
     let* { size_sectors; sector_size; _ } = BLOCK.get_info block in
     let ( let*? ) = Lwt_result.bind in
     (* ocaml-gpt uses a fixed size partition entries table. Create an empty GPT
@@ -110,6 +110,16 @@ module Make(BLOCK : Mirage_block.S) = struct
       Gpt.make ~sector_size ~disk_sectors:size_sectors []
       |> Result.get_ok
     in
+    let mb_in_sectors mb =
+      (* 1 megabyte is 2^20 bytes (1024 * 1024) *)
+      let mb_in_bytes = Int64.(shift_left (of_int mb) 20) in
+      let ss = Int64.of_int sector_size in
+      Int64.(div (add mb_in_bytes (sub ss 1L)) ss)
+    in
+    let sectors_cache = mb_in_sectors cache_size
+    and sectors_git = mb_in_sectors git_size
+    and sectors_swap = mb_in_sectors swap_size
+    in
     let*? () =
       if size_sectors <
          (* protective MBR + GPT header + GPT table *)
@@ -175,9 +185,9 @@ module Make(BLOCK : Mirage_block.S) = struct
       Gpt.make ~sector_size ~disk_sectors:size_sectors partitions
       |> Result.get_ok
     in
-  let buf =
-    Cstruct.create (sector_size * (Int64.to_int gpt.first_usable_lba + 2 * Tar.Header.length))
-  in
+    let buf =
+      Cstruct.create (sector_size * (Int64.to_int gpt.first_usable_lba + 2 * Tar.Header.length))
+    in
     Gptar.marshal_header ~sector_size buf gpt;
     Gpt.marshal_partition_table ~sector_size
       (Cstruct.shift buf (sector_size * Int64.to_int gpt.partition_entry_lba))
diff --git a/mirage/unikernel.ml b/mirage/unikernel.ml
index 3d62810..ef1f985 100644
--- a/mirage/unikernel.ml
+++ b/mirage/unikernel.ml
@@ -59,20 +59,20 @@ module K = struct
     let doc = Arg.info ~doc:"HTTP listen port." ["port"] in
     Mirage_runtime.register_arg Arg.(value & opt int 80 doc)
 
-  let sectors_cache =
-    let doc = "Number of sectors reserved for each checksum cache (md5, sha512). Only used with --initialize-disk." in
-    let doc = Arg.info ~doc ["sectors-cache"] in
-    Mirage_runtime.register_arg Arg.(value & opt int64 Int64.(mul 4L 2048L) doc)
+  let cache_size =
+    let doc = "Number of MB reserved for each checksum cache (md5, sha512). Only used with --initialize-disk." in
+    let doc = Arg.info ~doc ["cache-size"] in
+    Mirage_runtime.register_arg Arg.(value & opt int 4 doc)
 
-  let sectors_git =
-    let doc = "Number of sectors reserved for git dump. Only used with --initialize-disk" in
-    let doc = Arg.info ~doc ["sectors-git"] in
-    Mirage_runtime.register_arg Arg.(value & opt int64 Int64.(mul 40L (mul 2L 1024L)) doc)
+  let git_size =
+    let doc = "Number of MB reserved for git dump. Only used with --initialize-disk" in
+    let doc = Arg.info ~doc ["git-size"] in
+    Mirage_runtime.register_arg Arg.(value & opt int 40 doc)
 
-  let sectors_swap =
-    let doc = "Number of sectors reserved for swap. Only used with --initialize-disk" in
-    let doc = Arg.info ~doc ["sectors-swap"] in
-    Mirage_runtime.register_arg Arg.(value & opt int64 Int64.(mul 1024L 2048L) doc)
+  let swap_size =
+    let doc = "Number of MB reserved for swap. Only used with --initialize-disk" in
+    let doc = Arg.info ~doc ["swap-size"] in
+    Mirage_runtime.register_arg Arg.(value & opt int 1024 doc)
 
   let initialize_disk =
     let doc = "Initialize the disk with a partition table. THIS IS DESTRUCTIVE!" in
@@ -1123,11 +1123,11 @@ stamp: %S
 
   let start block _time _pclock stack git_ctx http_ctx =
     let initialize_disk = K.initialize_disk ()
-    and sectors_cache = K.sectors_cache ()
-    and sectors_git = K.sectors_git ()
-    and sectors_swap = K.sectors_swap () in
+    and cache_size = K.cache_size ()
+    and git_size = K.git_size ()
+    and swap_size = K.swap_size () in
     if initialize_disk then
-      Part.format block ~sectors_cache ~sectors_git ~sectors_swap >>= function
+      Part.format block ~cache_size ~git_size ~swap_size >>= function
       | Ok () ->
         Logs.app (fun m -> m "Successfully initialized the disk! You may restart now without --initialize-disk.");
         Lwt.return_unit
-- 
2.47.0