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

Merge pull request 'add some Lwt.pause during Disk.check to allow the web server to process requests' (#26) from add-pause-during-check into main

Browse source 
Reviewed-on: #26
Reviewed-by: Reynir Björnsson <reynir@reynir.dk>
This commit is contained in:
Reynir Björnsson 2024-11-21 11:31:04 +00:00
commit 6447339f64
1 changed files with 11 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
mirage/unikernel.ml
View file

@ -537,10 +537,17 @@ module Make
| Some f -> | Some f ->
read_chunked t `SHA256 path read_chunked t `SHA256 path
(fun (sha256, md5, sha512) data -> (fun (sha256, md5, sha512) data ->
Lwt.return let sha256 = SHA256.feed_string sha256 data in
(SHA256.feed_string sha256 data, Lwt.pause () >>= fun () ->
Option.map (fun t -> MD5.feed_string t data) md5, let md5 =
Option.map (fun t -> SHA512.feed_string t data) sha512)) Option.map (fun t -> MD5.feed_string t data) md5
in
Lwt.pause () >>= fun () ->
let sha512 =
Option.map (fun t -> SHA512.feed_string t data) sha512
in
Lwt.pause () >|= fun () ->
sha256, md5, sha512)
(SHA256.empty, (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