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 "mirage-block-partition" ;
package "oneffs" ;
package "gmp" ;
]
(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 happy_eyeballs = generic_happy_eyeballs stack dns in
let git_happy_eyeballs = git_happy_eyeballs stack dns happy_eyeballs in
merge_git_clients (git_tcp tcp git_happy_eyeballs)
(git_http ~authenticator:tls_authenticator tcp git_happy_eyeballs),
let git = mimic_happy_eyeballs stack dns happy_eyeballs in
merge_git_clients (git_tcp tcp git)
(git_http ~authenticator:tls_authenticator tcp git),
paf_client ~pclock:default_posix_clock tcp (mimic_happy_eyeballs stack dns happy_eyeballs)
let program_block_size =

27
mirage/unikernel.ml
View file

@ -503,12 +503,14 @@ module Make
(fun (h, csum) -> String.equal csum (HM.find h csums))
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 =
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
| `Init -> assert false
in
let source = pending_key (hash, csum) in
if check_csums_digests csums digests && sizes_match then
let sha256 = to_hex (Mirage_crypto.Hash.SHA256.get digests.sha256)
and md5 = to_hex (Mirage_crypto.Hash.MD5.get digests.md5)
@ -518,23 +520,26 @@ module Make
| `Unknown body ->
Logs.info (fun m -> m "downloaded %s, now writing" url);
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);
let source = pending_key (hash, csum) in
KV.rename t.dev ~source ~dest
end >|= function
| `Init -> assert false
end >|= function
| Ok () ->
t.md5s <- SM.add md5 sha256 t.md5s;
t.sha512s <- SM.add sha512 sha256 t.sha512s
| Error e ->
Logs.err (fun m -> m "Write failure for %s: %a" url KV.pp_write_error e)
else begin
if sizes_match then
Logs.err (fun m -> m "Bad checksum %s: computed %s expected %s" url
(hash_to_string hash) (hex_to_string csum))
else
Logs.err (fun m -> m "Size mismatch %s: received %a bytes expected %a bytes" url
Optint.Int63.pp actual Optint.Int63.pp reported);
(if sizes_match then
Logs.err (fun m -> m "Bad checksum %s: computed %s expected %s" url
(hash_to_string hash) (hex_to_string csum))
else match body with
| `Fixed_body (reported, actual) ->
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 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