Use GPTar table

We expect the disk to be formatted already.
This commit is contained in:
Reynir Björnsson 2024-10-04 16:03:54 +02:00
parent 9ada5c4a94
commit d36a0714e7
3 changed files with 97 additions and 11 deletions

View file

@ -14,6 +14,8 @@ let mirror =
package ~min:"3.0.0" ~sublibs:[ "gz" ] "tar" ;
package ~min:"3.0.0" "tar-mirage" ;
package ~max:"0.2.0" "mirage-block-partition" ;
package "gpt" ;
package "gptar" ~pin:"git+https://github.com/reynir/gptar.git" ;
package "oneffs" ;
package "digestif" ;
]

91
mirage/partitions.ml Normal file
View file

@ -0,0 +1,91 @@
open Lwt.Syntax
module Make(BLOCK : Mirage_block.S) = struct
module Part = Mirage_block_partition.Make(BLOCK)
include Part
type partitions = {
tar : Part.t ;
git_dump : Part.t ;
md5s : Part.t ;
sha512s : Part.t ;
}
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] *)
let* r = BLOCK.read block 1L [b] in
match r with
| Error e ->
Format.kasprintf failwith "Reading partition table: %a"
BLOCK.pp_error e
| Ok () ->
match Gpt.unmarshal b ~sector_size:info.Mirage_block.sector_size with
| Error e ->
Format.kasprintf failwith "Reading partition table: %s" e
| Ok (`Read_partition_table (lba, sectors), k) ->
let b = Cstruct.create (sectors * info.Mirage_block.sector_size) in
let* r = BLOCK.read block lba [b] in
match r with
| Error e ->
Format.kasprintf failwith "Reading partition table: %a"
BLOCK.pp_error e
| Ok () ->
match k b with
| Error e ->
Format.kasprintf failwith "Reading partition table: %s" e
| 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 =
match
List.fold_left
(fun (tar, git_dump, md5s, sha512s) p ->
if String.equal p.Gpt.Partition.name
(utf16be_of_ascii "tar")
then
(Some p, git_dump, md5s, sha512s)
else if String.equal p.name
(utf16be_of_ascii "git_dump")
then
(tar, Some p, md5s, sha512s)
else if String.equal p.name
(utf16be_of_ascii "md5s")
then
(tar, git_dump, Some p, sha512s)
else if String.equal p.name
(utf16be_of_ascii "sha512s")
then
(tar, git_dump, md5s, Some p)
else
Format.kasprintf failwith "Unknown partition %S" p.name)
(None, None, None, None)
gpt.partitions
with
| (Some tar, Some git_dump, Some md5s, Some sha512s) ->
(tar, git_dump, md5s, sha512s)
| _ ->
failwith "not all partitions found :("
in
let+ (_empty, p) = Part.connect 0L block in
let get_part part =
let len = Int64.(succ (sub part.Gpt.Partition.ending_lba part.starting_lba)) in
let (_before, after) = Part.subpartition part.starting_lba p in
let (part, _after) = Part.subpartition len after in
part
in
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 }
end

View file

@ -67,7 +67,7 @@ module Make
(_ : sig end)
(HTTP : Http_mirage_client.S) = struct
module Part = Mirage_block_partition.Make(BLOCK)
module Part = Partitions.Make(BLOCK)
module KV = Tar_mirage.Make_KV_RW(Pclock)(Part)
module Cache = OneFFS.Make(Part)
module Store = Git_kv.Make(Pclock)
@ -985,18 +985,11 @@ stamp: %S
module Paf = Paf_mirage.Make(Stack.TCP)
let start block _time _pclock stack git_ctx http_ctx =
BLOCK.get_info block >>= fun info ->
let git_start =
let cache_size = Int64.(mul 2L (K.sectors_cache ())) in
Int64.(sub info.size_sectors (add cache_size (K.sectors_git ())))
in
Part.connect git_start block >>= fun (kv, rest) ->
let git_dump, rest = Part.subpartition (K.sectors_git ()) rest in
let md5s, sha512s = Part.subpartition (K.sectors_cache ()) rest in
KV.connect kv >>= fun kv ->
Part.connect block >>= fun { Part.tar ; git_dump; md5s ; sha512s } ->
KV.connect tar >>= fun kv ->
Cache.connect git_dump >>= fun git_dump ->
Cache.connect md5s >>= fun md5s ->
Cache.connect sha512s >>= fun sha512s ->
Cache.connect git_dump >>= fun git_dump ->
Logs.info (fun m -> m "Available bytes in tar storage: %Ld" (KV.free kv));
Disk.init ~verify_sha256:(K.verify_sha256 ()) kv md5s sha512s >>= fun disk ->
let remote = K.remote () in