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

initialization: potentially rename bad data

Browse source
This commit is contained in:
Hannes Mehnert 2024-11-04 17:25:08 +01:00
parent a9b8f18192
commit 1e35bfefbd
1 changed files with 39 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

63
mirage/unikernel.ml
View file

@ -380,19 +380,7 @@ module Make
Lwt.return_unit Lwt.return_unit
| `Value -> | `Value ->
let open Digestif in let open Digestif in
let sha256_final = let md5_final =
if verify_sha256 then
let f s =
let digest = SHA256.(to_raw_string (get s)) in
if not (String.equal (Mirage_kv.Key.basename path) (Ohex.encode digest)) then
Logs.err (fun m -> m "corrupt SHA256 data for %a, \
computed %s (should remove)"
Mirage_kv.Key.pp path (Ohex.encode digest))
in
Some f
else
None
and md5_final =
if not (SSet.mem (Mirage_kv.Key.basename path) md5s) then if not (SSet.mem (Mirage_kv.Key.basename path) md5s) then
let f s = let f s =
let digest = MD5.(to_raw_string (get s)) in let digest = MD5.(to_raw_string (get s)) in
@ -411,26 +399,53 @@ module Make
else else
None None
in in
match sha256_final, md5_final, sha512_final with let sha256_final =
| None, None, None -> Lwt.return_unit let need_to_compute = md5_final <> None || sha512_final <> None || verify_sha256 in
| _ -> if need_to_compute then
let f s =
let digest = SHA256.(to_raw_string (get s)) in
if not (String.equal (Mirage_kv.Key.basename path) (Ohex.encode digest)) then
begin
Logs.err (fun m -> m "corrupt SHA256 data for %a, \
computed %s (will rename)"
Mirage_kv.Key.pp path (Ohex.encode digest));
false
end else true
in
Some f
else
None
in
match sha256_final with
| None -> Lwt.return_unit
| Some f ->
read_chunked t `SHA256 path read_chunked t `SHA256 path
(fun (sha256, md5, sha512) data -> (fun (sha256, md5, sha512) data ->
Lwt.return Lwt.return
(Option.map (fun t -> SHA256.feed_string t data) sha256, (SHA256.feed_string sha256 data,
Option.map (fun t -> MD5.feed_string t data) md5, Option.map (fun t -> MD5.feed_string t data) md5,
Option.map (fun t -> SHA512.feed_string t data) sha512)) Option.map (fun t -> SHA512.feed_string t data) sha512))
(Option.map (fun _ -> SHA256.empty) sha256_final, (SHA256.empty,
Option.map (fun _ -> MD5.empty) md5_final, Option.map (fun _ -> MD5.empty) md5_final,
Option.map (fun _ -> SHA512.empty) sha512_final) >|= function Option.map (fun _ -> SHA512.empty) sha512_final) >>= function
| Error e -> | Error e ->
Logs.err (fun m -> m "error %a of %a while computing digests" Logs.err (fun m -> m "error %a of %a while computing digests"
KV.pp_error e Mirage_kv.Key.pp path) KV.pp_error e Mirage_kv.Key.pp path);
Lwt.return_unit
| Ok (sha256, md5, sha512) -> | Ok (sha256, md5, sha512) ->
Option.iter (fun f -> f (Option.get sha256)) sha256_final; if not (f sha256) then
Option.iter (fun f -> f (Option.get md5)) md5_final; (* bad sha256! *)
Option.iter (fun f -> f (Option.get sha512)) sha512_final; KV.rename t.dev ~source:path ~dest:(Mirage_kv.Key.(v "delete" // path)) >|= function
Logs.info (fun m -> m "added %a" Mirage_kv.Key.pp path)) | Ok () -> ()
| Error we ->
Logs.err (fun m -> m "error %a while renaming %a" KV.pp_write_error we
Mirage_kv.Key.pp path)
else begin
Option.iter (fun f -> f (Option.get md5)) md5_final;
Option.iter (fun f -> f (Option.get sha512)) sha512_final;
Logs.info (fun m -> m "added %a" Mirage_kv.Key.pp path);
Lwt.return_unit
end)
entries >>= fun () -> entries >>= fun () ->
update_caches t >|= fun () -> update_caches t >|= fun () ->
t t