From ceb4674ec2bc3c41252b60d7618ef523ab90cdd0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Wed, 9 Oct 2024 18:42:01 +0200 Subject: [PATCH] Add code for formatting a disk --- mirage/partitions.ml | 97 ++++++++++++++++++++++++++++++++++++++++---- mirage/unikernel.ml | 29 +++++++++++-- 2 files changed, 114 insertions(+), 12 deletions(-) diff --git a/mirage/partitions.ml b/mirage/partitions.ml index c438b3c..35748a6 100644 --- a/mirage/partitions.ml +++ b/mirage/partitions.ml @@ -12,6 +12,20 @@ module Make(BLOCK : Mirage_block.S) = struct sha512s : Part.t ; } + (* I just made these ones up... *) + let tar_guid = Uuidm.of_string "53cd6812-46cc-474e-a141-30b3aed85f53" |> Option.get + let cache_guid = Uuidm.of_string "22ab9cf5-6e51-45c2-998a-862e23aab264" |> Option.get + let git_guid = Uuidm.of_string "30faa50a-4c9d-47ff-a1a5-ecfb3401c027" |> Option.get + + (* GPT uses a 72 byte utf16be encoded string for partition names *) + let utf16be_of_ascii s = + String.init 72 + (fun i -> + if i mod 2 = 0 && i / 2 < String.length s then + s.[i/2] + else + '\000') + let read_partition_table info block = let b = Cstruct.create info.Mirage_block.sector_size in (* We will ignore the protective MBR at lba [0L] *) @@ -38,14 +52,6 @@ module Make(BLOCK : Mirage_block.S) = struct | Ok gpt -> Lwt.return gpt let connect block = - let utf16be_of_ascii s = - String.init 72 - (fun i -> - if i mod 2 = 0 && i / 2 < String.length s then - s.[i/2] - else - '\000') - in let* info = BLOCK.get_info block in let* gpt = read_partition_table info block in let tar, git_dump, md5s, sha512s = @@ -88,4 +94,79 @@ module Make(BLOCK : Mirage_block.S) = struct let tar = get_part tar and git_dump = get_part git_dump and md5s = get_part md5s and sha512s = get_part sha512s in { tar ; git_dump ; md5s ; sha512s } + + let format block ~sectors_cache ~sectors_git = + 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 + to figure out the first usable LBA *) + let empty = + Gpt.make ~sector_size ~disk_sectors:size_sectors [] + |> Result.get_ok + in + let*? () = + if size_sectors < + (* protective MBR + GPT header + GPT table *) + let ( + ) = Int64.add in + empty.first_usable_lba + + min 1L (Int64.of_int (2 * Tar.Header.length / sector_size)) + sectors_cache + sectors_cache + sectors_git + + 1L (* backup GPT header *) then + Lwt.return_error (`Msg "too small disk") + else Lwt_result.return () + in + let gpt = + let partitions = + (* Current implementation of [Gpt.Partition.make] only returns [Ok _] or + raises [Invalid_argument _] :/ *) + let attributes = 1L in + let sha512s = + Gpt.Partition.make + ~name:(utf16be_of_ascii "sha512s") + ~type_guid:cache_guid + ~attributes + Int64.(succ (sub empty.last_usable_lba sectors_cache)) + empty.last_usable_lba + |> Result.get_ok + in + let md5s = + Gpt.Partition.make + ~name:(utf16be_of_ascii "md5s") + ~type_guid:cache_guid + ~attributes + (Int64.sub sha512s.starting_lba sectors_cache) + (Int64.pred sha512s.starting_lba) + |> Result.get_ok + in + let git_dump = + Gpt.Partition.make + ~name:(utf16be_of_ascii "git_dump") + ~type_guid:git_guid + ~attributes + (Int64.sub md5s.starting_lba sectors_git) + (Int64.pred md5s.starting_lba) + |> Result.get_ok + in + let tar = + Gpt.Partition.make + ~name:(utf16be_of_ascii "tar") + ~type_guid:tar_guid + ~attributes + empty.first_usable_lba + (Int64.pred git_dump.starting_lba) + |> Result.get_ok + in + [ tar; git_dump; md5s; sha512s ] + in + 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 + 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)) + gpt; + BLOCK.write block 0L [ buf ] + |> Lwt_result.map_error (fun e -> `Block e) end diff --git a/mirage/unikernel.ml b/mirage/unikernel.ml index 2b94efc..af94243 100644 --- a/mirage/unikernel.ml +++ b/mirage/unikernel.ml @@ -44,15 +44,20 @@ module K = struct 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)." in + 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 sectors_git = - let doc = "Number of sectors reserved for git dump." in + 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 initialize_disk = + let doc = "Initialize the disk with a partition table. THIS IS DESTRUCTIVE!" in + let doc = Arg.info ~doc ["initialize-disk"] in + Mirage_runtime.register_arg Arg.(value & flag doc) + let ignore_local_git = let doc = "Ignore restoring locally saved git repository." in let doc = Arg.info ~doc ["ignore-local-git"] in @@ -984,8 +989,7 @@ stamp: %S module Paf = Paf_mirage.Make(Stack.TCP) - let start block _time _pclock stack git_ctx http_ctx = - Part.connect block >>= fun { Part.tar ; git_dump; md5s ; sha512s } -> + let start_mirror { Part.tar; git_dump; md5s; sha512s } stack git_ctx http_ctx = KV.connect tar >>= fun kv -> Cache.connect git_dump >>= fun git_dump -> Cache.connect md5s >>= fun md5s -> @@ -1036,4 +1040,21 @@ stamp: %S go ()); download_archives (K.parallel_downloads ()) disk http_ctx git_kv >>= fun () -> (th >|= fun _v -> ()) + + 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 () in + if initialize_disk then + Part.format block ~sectors_cache ~sectors_git >>= function + | Ok () -> Lwt.return_unit + | Error `Msg e -> + Logs.err (fun m -> m "Error formatting disk: %s" e); + exit Mirage_runtime.argument_error + | Error `Block e -> + Logs.err (fun m -> m "Error formatting disk: %a" BLOCK.pp_write_error e); + exit 2 + else + Part.connect block >>= fun parts -> + start_mirror parts stack git_ctx http_ctx end