specify sizes of partitions in MB, not in sectors #27
2 changed files with 30 additions and 20 deletions
|
@ -101,7 +101,7 @@ module Make(BLOCK : Mirage_block.S) = struct
|
||||||
and md5s = get_part md5s and sha512s = get_part sha512s in
|
and md5s = get_part md5s and sha512s = get_part sha512s in
|
||||||
{ tar ; swap; git_dump ; md5s ; sha512s }
|
{ 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* { size_sectors; sector_size; _ } = BLOCK.get_info block in
|
||||||
let ( let*? ) = Lwt_result.bind in
|
let ( let*? ) = Lwt_result.bind in
|
||||||
(* ocaml-gpt uses a fixed size partition entries table. Create an empty GPT
|
(* 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 []
|
Gpt.make ~sector_size ~disk_sectors:size_sectors []
|
||||||
|> Result.get_ok
|
|> Result.get_ok
|
||||||
in
|
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*? () =
|
let*? () =
|
||||||
if size_sectors <
|
if size_sectors <
|
||||||
(* protective MBR + GPT header + GPT table *)
|
(* protective MBR + GPT header + GPT table *)
|
||||||
|
|
|
@ -59,20 +59,20 @@ module K = struct
|
||||||
let doc = Arg.info ~doc:"HTTP listen port." ["port"] in
|
let doc = Arg.info ~doc:"HTTP listen port." ["port"] in
|
||||||
Mirage_runtime.register_arg Arg.(value & opt int 80 doc)
|
Mirage_runtime.register_arg Arg.(value & opt int 80 doc)
|
||||||
|
|
||||||
let sectors_cache =
|
let cache_size =
|
||||||
let doc = "Number of sectors reserved for each checksum cache (md5, sha512). Only used with --initialize-disk." in
|
let doc = "Number of MB reserved for each checksum cache (md5, sha512). Only used with --initialize-disk." in
|
||||||
let doc = Arg.info ~doc ["sectors-cache"] in
|
let doc = Arg.info ~doc ["cache-size"] in
|
||||||
Mirage_runtime.register_arg Arg.(value & opt int64 Int64.(mul 4L 2048L) doc)
|
Mirage_runtime.register_arg Arg.(value & opt int 4 doc)
|
||||||
|
|
||||||
let sectors_git =
|
let git_size =
|
||||||
let doc = "Number of sectors reserved for git dump. Only used with --initialize-disk" in
|
let doc = "Number of MB reserved for git dump. Only used with --initialize-disk" in
|
||||||
let doc = Arg.info ~doc ["sectors-git"] in
|
let doc = Arg.info ~doc ["git-size"] in
|
||||||
Mirage_runtime.register_arg Arg.(value & opt int64 Int64.(mul 40L (mul 2L 1024L)) doc)
|
Mirage_runtime.register_arg Arg.(value & opt int 40 doc)
|
||||||
|
|
||||||
let sectors_swap =
|
let swap_size =
|
||||||
let doc = "Number of sectors reserved for swap. Only used with --initialize-disk" in
|
let doc = "Number of MB reserved for swap. Only used with --initialize-disk" in
|
||||||
let doc = Arg.info ~doc ["sectors-swap"] in
|
let doc = Arg.info ~doc ["swap-size"] in
|
||||||
Mirage_runtime.register_arg Arg.(value & opt int64 Int64.(mul 1024L 2048L) doc)
|
Mirage_runtime.register_arg Arg.(value & opt int 1024 doc)
|
||||||
|
|
||||||
let initialize_disk =
|
let initialize_disk =
|
||||||
let doc = "Initialize the disk with a partition table. THIS IS DESTRUCTIVE!" in
|
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 start block _time _pclock stack git_ctx http_ctx =
|
||||||
let initialize_disk = K.initialize_disk ()
|
let initialize_disk = K.initialize_disk ()
|
||||||
and sectors_cache = K.sectors_cache ()
|
and cache_size = K.cache_size ()
|
||||||
and sectors_git = K.sectors_git ()
|
and git_size = K.git_size ()
|
||||||
and sectors_swap = K.sectors_swap () in
|
and swap_size = K.swap_size () in
|
||||||
if initialize_disk then
|
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 () ->
|
| Ok () ->
|
||||||
Logs.app (fun m -> m "Successfully initialized the disk! You may restart now without --initialize-disk.");
|
Logs.app (fun m -> m "Successfully initialized the disk! You may restart now without --initialize-disk.");
|
||||||
Lwt.return_unit
|
Lwt.return_unit
|
||||||
|
|
Loading…
Reference in a new issue