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

compiles now

Browse source
This commit is contained in:
Hannes Mehnert 2023-05-02 16:13:43 +02:00
parent fd8ce3be03
commit 1ebf370a4f
2 changed files with 20 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
mirage/config.ml
View file

@ -83,6 +83,7 @@ let mirror =
package ~min:"2.2.0" "tar-mirage" ; package ~min:"2.2.0" "tar-mirage" ;
package "mirage-block-partition" ; package "mirage-block-partition" ;
package "oneffs" ; package "oneffs" ;
package "gmp" ;
] ]
(block @-> time @-> pclock @-> stackv4v6 @-> git_client @-> alpn_client @-> job) (block @-> time @-> pclock @-> stackv4v6 @-> git_client @-> alpn_client @-> job)
@ -94,9 +95,9 @@ let tcp = tcpv4v6_of_stackv4v6 stack
let git_client, alpn_client = let git_client, alpn_client =
let happy_eyeballs = generic_happy_eyeballs stack dns in let happy_eyeballs = generic_happy_eyeballs stack dns in
let git_happy_eyeballs = git_happy_eyeballs stack dns happy_eyeballs in let git = mimic_happy_eyeballs stack dns happy_eyeballs in
merge_git_clients (git_tcp tcp git_happy_eyeballs) merge_git_clients (git_tcp tcp git)
(git_http ~authenticator:tls_authenticator tcp git_happy_eyeballs), (git_http ~authenticator:tls_authenticator tcp git),
paf_client ~pclock:default_posix_clock tcp (mimic_happy_eyeballs stack dns happy_eyeballs) paf_client ~pclock:default_posix_clock tcp (mimic_happy_eyeballs stack dns happy_eyeballs)
let program_block_size = let program_block_size =

25
mirage/unikernel.ml
View file

@ -503,12 +503,14 @@ module Make
(fun (h, csum) -> String.equal csum (HM.find h csums)) (fun (h, csum) -> String.equal csum (HM.find h csums))
common_bindings common_bindings
let finalize_write t (hash, csum) ~url body csums digests = let finalize_write t (hash, csum) ~url (body : [ `Unknown of string | `Fixed_body of int64 * Optint.Int63.t | `Init ]) csums digests =
let sizes_match, body_size_in_header = let sizes_match, body_size_in_header =
match body with match body with
| `Fixed_body (reported, actual) -> Optint.Int63.(equal (of_int reported) actual), true | `Fixed_body (reported, actual) -> Optint.Int63.(equal (of_int64 reported) actual), true
| `Unknown _ -> true, false | `Unknown _ -> true, false
| `Init -> assert false
in in
let source = pending_key (hash, csum) in
if check_csums_digests csums digests && sizes_match then if check_csums_digests csums digests && sizes_match then
let sha256 = to_hex (Mirage_crypto.Hash.SHA256.get digests.sha256) let sha256 = to_hex (Mirage_crypto.Hash.SHA256.get digests.sha256)
and md5 = to_hex (Mirage_crypto.Hash.MD5.get digests.md5) and md5 = to_hex (Mirage_crypto.Hash.MD5.get digests.md5)
@ -518,10 +520,10 @@ module Make
| `Unknown body -> | `Unknown body ->
Logs.info (fun m -> m "downloaded %s, now writing" url); Logs.info (fun m -> m "downloaded %s, now writing" url);
KV.set t.dev dest body KV.set t.dev dest body
| `Fixed_body (reported_size, actual_size) -> | `Fixed_body (_reported_size, _actual_size) ->
Logs.info (fun m -> m "downloaded %s" url); Logs.info (fun m -> m "downloaded %s" url);
let source = pending_key (hash, csum) in
KV.rename t.dev ~source ~dest KV.rename t.dev ~source ~dest
| `Init -> assert false
end >|= function end >|= function
| Ok () -> | Ok () ->
t.md5s <- SM.add md5 sha256 t.md5s; t.md5s <- SM.add md5 sha256 t.md5s;
@ -529,12 +531,15 @@ module Make
| Error e -> | Error e ->
Logs.err (fun m -> m "Write failure for %s: %a" url KV.pp_write_error e) Logs.err (fun m -> m "Write failure for %s: %a" url KV.pp_write_error e)
else begin else begin
if sizes_match then (if sizes_match then
Logs.err (fun m -> m "Bad checksum %s: computed %s expected %s" url Logs.err (fun m -> m "Bad checksum %s: computed %s expected %s" url
(hash_to_string hash) (hex_to_string csum)) (hash_to_string hash) (hex_to_string csum))
else else match body with
Logs.err (fun m -> m "Size mismatch %s: received %a bytes expected %a bytes" url | `Fixed_body (reported, actual) ->
Optint.Int63.pp actual Optint.Int63.pp reported); Logs.err (fun m -> m "Size mismatch %s: received %a bytes expected %Lu bytes"
url Optint.Int63.pp actual reported)
| `Unknown _ -> assert false
| `Init -> assert false);
if body_size_in_header then if body_size_in_header then
(* if the checksums mismatch we want to delete the file. We are only (* if the checksums mismatch we want to delete the file. We are only
able to do so if it was the latest created file, so we expect and able to do so if it was the latest created file, so we expect and