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

.

Browse source
This commit is contained in:
Hannes Mehnert 2018-09-22 00:26:52 +02:00
parent 02f8d94db8
commit 95cdd18f44
3 changed files with 7 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
README.md
View file

@ -65,7 +65,7 @@ DEV> cd mirage-skeleton/tutorial/hello
DEV> mirage configure -t hvt DEV> mirage configure -t hvt
DEV> mirage build DEV> mirage build
DEV> mv solo5-hvt /tmp/solo5-hvt.none DEV> mv solo5-hvt /tmp/solo5-hvt.none
DEV> cd ../device-usage/network DEV> cd ../../device-usage/network
DEV> mirage configure -t hvt DEV> mirage configure -t hvt
DEV> mirage build DEV> mirage build
DEV> mv solo5-hvt /tmp/solo5-hvt.net DEV> mv solo5-hvt /tmp/solo5-hvt.net

8
app/vmm_console.ml
View file

@ -33,7 +33,7 @@ let read_console name ring channel () =
| Some fd -> | Some fd ->
Vmm_lwt.write_wire fd (Vmm_wire.Console.data my_version id t line) >>= function Vmm_lwt.write_wire fd (Vmm_wire.Console.data my_version id t line) >>= function
| Error _ -> | Error _ ->
Lwt.catch (fun () -> Lwt_unix.close fd) (fun _ -> Lwt.return_unit) >|= fun () -> Vmm_lwt.safe_close fd >|= fun () ->
active := String.Map.remove name !active active := String.Map.remove name !active
| Ok () -> Lwt.return_unit) >>= | Ok () -> Lwt.return_unit) >>=
loop loop
@ -83,7 +83,9 @@ let attach s id =
let name = Vmm_core.string_of_id id in let name = Vmm_core.string_of_id id in
Logs.debug (fun m -> m "attempting to attach %a" Vmm_core.pp_id id) ; Logs.debug (fun m -> m "attempting to attach %a" Vmm_core.pp_id id) ;
match String.Map.find name !t with match String.Map.find name !t with
| None -> Lwt.return (Error (`Msg "not found")) | None ->
active := String.Map.add name s !active ;
Lwt.return (Ok "waiing for VM")
| Some r -> | Some r ->
let entries = Vmm_ring.read r in let entries = Vmm_ring.read r in
Logs.debug (fun m -> m "found %d history" (List.length entries)) ; Logs.debug (fun m -> m "found %d history" (List.length entries)) ;
@ -131,7 +133,7 @@ let handle s addr () =
Lwt.return_unit Lwt.return_unit
in in
loop () >>= fun () -> loop () >>= fun () ->
Lwt.catch (fun () -> Lwt_unix.close s) (fun _ -> Lwt.return_unit) >|= fun () -> Vmm_lwt.safe_close s >|= fun () ->
Logs.warn (fun m -> m "disconnected") Logs.warn (fun m -> m "disconnected")
let jump _ file = let jump _ file =

2
stats/vmm_stats_lwt.ml
View file

@ -42,7 +42,7 @@ let handle s addr () =
| Error _ -> Logs.err (fun m -> m "exception while writing") ; Lwt.return acc | Error _ -> Logs.err (fun m -> m "exception while writing") ; Lwt.return acc
in in
loop [] >>= fun vmids -> loop [] >>= fun vmids ->
Lwt.catch (fun () -> Lwt_unix.close s) (fun _ -> Lwt.return_unit) >|= fun () -> Vmm_lwt.safe_close s >|= fun () ->
Logs.warn (fun m -> m "disconnect, dropping %d vms!" (List.length vmids)) ; Logs.warn (fun m -> m "disconnect, dropping %d vms!" (List.length vmids)) ;
let t' = Vmm_stats.remove_vmids !t vmids in let t' = Vmm_stats.remove_vmids !t vmids in
t := t' t := t'