From 1ff5c7e1b63623363008fd45610874b64cb4c297 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Fri, 28 Oct 2022 13:57:30 +0200 Subject: [PATCH 1/2] if --verify is passed, don't use the md5s/sha512s from disk, instead re-create them --- mirage/unikernel.ml | 32 ++++++-------------------------- 1 file changed, 6 insertions(+), 26 deletions(-) diff --git a/mirage/unikernel.ml b/mirage/unikernel.ml index f9cc4f8..59420e2 100644 --- a/mirage/unikernel.ml +++ b/mirage/unikernel.ml @@ -283,12 +283,16 @@ module Make let t = empty dev dev_md5s dev_sha512s in Cache.read t.dev_md5s >>= fun r -> (match r with - | Ok Some s -> Result.iter (fun md5s -> t.md5s <- md5s) (unmarshal_sm s) + | Ok Some s -> + if not verify then + Result.iter (fun md5s -> t.md5s <- md5s) (unmarshal_sm s) | 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)); Cache.read t.dev_sha512s >>= fun r -> (match r with - | Ok Some s -> Result.iter (fun sha512s -> t.sha512s <- sha512s) (unmarshal_sm s) + | Ok Some s -> + if not verify then + Result.iter (fun sha512s -> t.sha512s <- sha512s) (unmarshal_sm s) | 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)); let md5s = SSet.of_list (List.map snd (SM.bindings t.md5s)) @@ -321,18 +325,6 @@ module Make t.md5s <- SM.add (to_hex digest) name t.md5s in 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 None and sha512_final = @@ -342,18 +334,6 @@ module Make t.sha512s <- SM.add (to_hex digest) name t.sha512s in 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 None in From d143e9b7660009ce77036ccf975fa31545c24595 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Fri, 28 Oct 2022 14:58:58 +0200 Subject: [PATCH 2/2] as suggested by @reynir: verify -> verify_sha256 --- mirage/config.ml | 10 ++++++---- mirage/unikernel.ml | 10 +++++----- 2 files changed, 11 insertions(+), 9 deletions(-) diff --git a/mirage/config.ml b/mirage/config.ml index 1a4d51c..6213c51 100644 --- a/mirage/config.ml +++ b/mirage/config.ml @@ -9,11 +9,13 @@ let check = in Key.(create "check" Arg.(flag doc)) -let verify = +let verify_sha256 = 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 - Key.(create "verify" Arg.(flag doc)) + Key.(create "verify-sha256" Arg.(flag doc)) let remote = let doc = @@ -67,7 +69,7 @@ let ignore_local_git = let mirror = 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 port ; Key.v sectors_cache ; Key.v sectors_git ; Key.v ignore_local_git ; diff --git a/mirage/unikernel.ml b/mirage/unikernel.ml index 59420e2..4c71f1d 100644 --- a/mirage/unikernel.ml +++ b/mirage/unikernel.ml @@ -276,7 +276,7 @@ module Make read_more a 0 (* 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 | Error e -> Logs.err (fun m -> m "error %a listing kv" KV.pp_error e); assert false | Ok entries -> @@ -284,14 +284,14 @@ module Make Cache.read t.dev_md5s >>= fun r -> (match r with | Ok Some s -> - if not verify then + 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") | Error e -> Logs.warn (fun m -> m "Error reading md5s cache: %a" Cache.pp_error e)); Cache.read t.dev_sha512s >>= fun r -> (match r with | Ok Some s -> - if not verify then + 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") | Error e -> Logs.warn (fun m -> m "Error reading sha512s cache: %a" Cache.pp_error e)); @@ -307,7 +307,7 @@ module Make | `Value -> let open Mirage_crypto.Hash in let sha256_final = - if verify then + if verify_sha256 then let f s = let digest = SHA256.get s in if not (String.equal name (to_hex digest)) then @@ -771,7 +771,7 @@ stamp: %S 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:(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 Lwt.return_unit else