reynir/albatross
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

vmmd_log: send ack on data receive

Browse source
This commit is contained in:
Hannes Mehnert 2018-10-26 00:43:37 +02:00
parent 01f933702d
commit aa051d62cd
1 changed files with 4 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
app/vmmd_log.ml
View file

@ -96,11 +96,12 @@ let send_history s ring id ts =
| Error e -> Lwt.return (Error e)) | Error e -> Lwt.return (Error e))
(Ok ()) (List.rev res) (Ok ()) (List.rev res)
let handle_data mvar ring hdr entry = let handle_data s mvar ring hdr entry =
if not (Vmm_commands.version_eq hdr.Vmm_commands.version my_version) then begin if not (Vmm_commands.version_eq hdr.Vmm_commands.version my_version) then begin
Logs.warn (fun m -> m "unsupported version") ; Logs.warn (fun m -> m "unsupported version") ;
Lwt.return_unit Lwt.return_unit
end else begin end else begin
Vmm_lwt.write_wire s (hdr, `Success `Empty) >>= fun _ ->
Vmm_ring.write ring entry ; Vmm_ring.write ring entry ;
Lwt_mvar.put mvar entry >>= fun () -> Lwt_mvar.put mvar entry >>= fun () ->
let data' = (hdr, `Data (`Log_data entry)) in let data' = (hdr, `Data (`Log_data entry)) in
@ -115,7 +116,7 @@ let read_data mvar ring s =
Logs.err (fun m -> m "error while reading") ; Logs.err (fun m -> m "error while reading") ;
Lwt.return_unit Lwt.return_unit
| Ok (hdr, `Data (`Log_data entry)) -> | Ok (hdr, `Data (`Log_data entry)) ->
handle_data mvar ring hdr entry >>= fun () -> handle_data s mvar ring hdr entry >>= fun () ->
loop () loop ()
| Ok wire -> | Ok wire ->
Logs.warn (fun m -> m "unexpected wire %a" Vmm_commands.pp_wire wire) ; Logs.warn (fun m -> m "unexpected wire %a" Vmm_commands.pp_wire wire) ;
@ -130,7 +131,7 @@ let handle mvar ring s addr () =
Logs.err (fun m -> m "error while reading") ; Logs.err (fun m -> m "error while reading") ;
Lwt.return_unit Lwt.return_unit
| Ok (hdr, `Data (`Log_data entry)) -> | Ok (hdr, `Data (`Log_data entry)) ->
handle_data mvar ring hdr entry >>= fun () -> handle_data s mvar ring hdr entry >>= fun () ->
read_data mvar ring s read_data mvar ring s
| Ok (hdr, `Command (`Log_cmd lc)) -> | Ok (hdr, `Command (`Log_cmd lc)) ->
if not (Vmm_commands.version_eq hdr.Vmm_commands.version my_version) then begin if not (Vmm_commands.version_eq hdr.Vmm_commands.version my_version) then begin