robur/opam-mirror
4
0
Fork 0
Code Issues 5 Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request 'if --verify is passed, don't use the md5s/sha512s from disk, instead re-create them' (#24) from trash-md5-sha512-on-verify into main

Browse source 
Reviewed-on: https://git.robur.io/robur/opam-mirror/pulls/24
This commit is contained in:
Hannes Mehnert 2022-10-28 12:59:33 +00:00
commit 878ecab0b2
2 changed files with 15 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
mirage/config.ml
View file

@ -9,11 +9,13 @@ let check =
in in
Key.(create "check" Arg.(flag doc)) Key.(create "check" Arg.(flag doc))
let verify = let verify_sha256 =
let doc = let doc =
Key.Arg.info ~doc:"Verify the cache contents" ["verify"] Key.Arg.info ~doc:"Verify the SHA256 checksums of the cache contents, and \
re-build the other checksum caches."
["verify-sha256"]
in in
Key.(create "verify" Arg.(flag doc)) Key.(create "verify-sha256" Arg.(flag doc))
let remote = let remote =
let doc = let doc =
@ -67,7 +69,7 @@ let ignore_local_git =
let mirror = let mirror =
foreign "Unikernel.Make" foreign "Unikernel.Make"
~keys:[ Key.v check ; Key.v verify ; Key.v remote ; ~keys:[ Key.v check ; Key.v verify_sha256 ; Key.v remote ;
Key.v parallel_downloads ; Key.v hook_url ; Key.v tls_authenticator ; Key.v parallel_downloads ; Key.v hook_url ; Key.v tls_authenticator ;
Key.v port ; Key.v sectors_cache ; Key.v sectors_git ; Key.v port ; Key.v sectors_cache ; Key.v sectors_git ;
Key.v ignore_local_git ; Key.v ignore_local_git ;

38
mirage/unikernel.ml
View file

@ -276,19 +276,23 @@ module Make
read_more a 0 read_more a 0
(* on disk, we use a flat file system where the filename is the sha256 of the data *) (* on disk, we use a flat file system where the filename is the sha256 of the data *)
let init ~verify dev dev_md5s dev_sha512s = let init ~verify_sha256 dev dev_md5s dev_sha512s =
KV.list dev Mirage_kv.Key.empty >>= function KV.list dev Mirage_kv.Key.empty >>= function
| Error e -> Logs.err (fun m -> m "error %a listing kv" KV.pp_error e); assert false | Error e -> Logs.err (fun m -> m "error %a listing kv" KV.pp_error e); assert false
| Ok entries -> | Ok entries ->
let t = empty dev dev_md5s dev_sha512s in let t = empty dev dev_md5s dev_sha512s in
Cache.read t.dev_md5s >>= fun r -> Cache.read t.dev_md5s >>= fun r ->
(match r with (match r with
| Ok Some s -> Result.iter (fun md5s -> t.md5s <- md5s) (unmarshal_sm s) | Ok Some s ->
if not verify_sha256 then
Result.iter (fun md5s -> t.md5s <- md5s) (unmarshal_sm s)
| Ok None -> Logs.debug (fun m -> m "No md5s cached") | Ok None -> Logs.debug (fun m -> m "No md5s cached")
| Error e -> Logs.warn (fun m -> m "Error reading md5s cache: %a" Cache.pp_error e)); | Error e -> Logs.warn (fun m -> m "Error reading md5s cache: %a" Cache.pp_error e));
Cache.read t.dev_sha512s >>= fun r -> Cache.read t.dev_sha512s >>= fun r ->
(match r with (match r with
| Ok Some s -> Result.iter (fun sha512s -> t.sha512s <- sha512s) (unmarshal_sm s) | Ok Some s ->
if not verify_sha256 then
Result.iter (fun sha512s -> t.sha512s <- sha512s) (unmarshal_sm s)
| Ok None -> Logs.debug (fun m -> m "No sha512s cached") | Ok None -> Logs.debug (fun m -> m "No sha512s cached")
| Error e -> Logs.warn (fun m -> m "Error reading sha512s cache: %a" Cache.pp_error e)); | Error e -> Logs.warn (fun m -> m "Error reading sha512s cache: %a" Cache.pp_error e));
let md5s = SSet.of_list (List.map snd (SM.bindings t.md5s)) let md5s = SSet.of_list (List.map snd (SM.bindings t.md5s))
@ -303,7 +307,7 @@ module Make
| `Value -> | `Value ->
let open Mirage_crypto.Hash in let open Mirage_crypto.Hash in
let sha256_final = let sha256_final =
if verify then if verify_sha256 then
let f s = let f s =
let digest = SHA256.get s in let digest = SHA256.get s in
if not (String.equal name (to_hex digest)) then if not (String.equal name (to_hex digest)) then
@ -321,18 +325,6 @@ module Make
t.md5s <- SM.add (to_hex digest) name t.md5s t.md5s <- SM.add (to_hex digest) name t.md5s
in in
Some f Some f
else if verify then
let f s =
let digest = MD5.get s |> to_hex in
match SM.find_opt digest t.md5s with
| Some x when String.equal name x -> ()
| y ->
Logs.err (fun m -> m "corrupt MD5 data for %s, \
expected %a, computed %s"
name Fmt.(option ~none:(any "NONE") string) y
digest)
in
Some f
else else
None None
and sha512_final = and sha512_final =
@ -342,18 +334,6 @@ module Make
t.sha512s <- SM.add (to_hex digest) name t.sha512s t.sha512s <- SM.add (to_hex digest) name t.sha512s
in in
Some f Some f
else if verify then
let f s =
let digest = SHA512.get s |> to_hex in
match SM.find_opt digest t.sha512s with
| Some x when String.equal name x -> ()
| y ->
Logs.err (fun m -> m "corrupt SHA512 data for %s, \
expected %a, computed %s"
name Fmt.(option ~none:(any "NONE") string) y
digest)
in
Some f
else else
None None
in in
@ -791,7 +771,7 @@ stamp: %S
Cache.connect sha512s >>= fun sha512s -> Cache.connect sha512s >>= fun sha512s ->
Cache.connect git_dump >>= fun git_dump -> Cache.connect git_dump >>= fun git_dump ->
Logs.info (fun m -> m "Available bytes in tar storage: %Ld" (KV.free kv)); Logs.info (fun m -> m "Available bytes in tar storage: %Ld" (KV.free kv));
Disk.init ~verify:(Key_gen.verify ()) kv md5s sha512s >>= fun disk -> Disk.init ~verify_sha256:(Key_gen.verify_sha256 ()) kv md5s sha512s >>= fun disk ->
if Key_gen.check () then if Key_gen.check () then
Lwt.return_unit Lwt.return_unit
else else