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

vmmd: poor mans statistics about uptime. created and destroyed vms

Browse source
This commit is contained in:
Hannes Mehnert 2018-03-22 14:09:57 +01:00
parent 42ca0670c9
commit ceab24948d
1 changed files with 22 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
app/vmmd.ml
View file

@ -1,5 +1,19 @@
(* (c) 2017 Hannes Mehnert, all rights reserved *) (* (c) 2017 Hannes Mehnert, all rights reserved *)
type stats = {
start : Ptime.t ;
vm_created : int ;
vm_destroyed : int ;
}
let s = ref { start = Ptime_clock.now () ; vm_created = 0 ; vm_destroyed = 0 }
let pp_stats ppf s =
let diff = Ptime.(diff (Ptime_clock.now ()) s.start) in
Fmt.pf ppf "up %a: %d vms created, %d vms destroyed, %d running"
Ptime.Span.pp diff
s.vm_created s.vm_destroyed (s.vm_created - s.vm_destroyed)
open Lwt.Infix open Lwt.Infix
let write_raw s data = let write_raw s data =
@ -58,9 +72,11 @@ let handle ca state t =
(match cont !state t with (match cont !state t with
| Ok (state', outs, vm) -> | Ok (state', outs, vm) ->
state := state' ; state := state' ;
s := { !s with vm_created = succ !s.vm_created } ;
Lwt.async (fun () -> Lwt.async (fun () ->
Vmm_lwt.wait_and_clear vm.Vmm_core.pid vm.Vmm_core.stdout >>= fun r -> Vmm_lwt.wait_and_clear vm.Vmm_core.pid vm.Vmm_core.stdout >>= fun r ->
let state', outs = Vmm_engine.handle_shutdown !state vm r in let state', outs = Vmm_engine.handle_shutdown !state vm r in
s := { !s with vm_destroyed = succ !s.vm_destroyed } ;
state := state' ; state := state' ;
process state outs) ; process state outs) ;
process state outs >>= fun () -> process state outs >>= fun () ->
@ -173,6 +189,11 @@ let cmp_s (_, a) (_, b) =
String.compare (Unix.string_of_inet_addr addr) (Unix.string_of_inet_addr addr') = 0 String.compare (Unix.string_of_inet_addr addr) (Unix.string_of_inet_addr addr') = 0
| _ -> false | _ -> false
let rec stats_loop () =
Logs.info (fun m -> m "%a" pp_stats !s) ;
Lwt_unix.sleep 600. >>= fun () ->
stats_loop ()
let jump _ dir cacert cert priv_key = let jump _ dir cacert cert priv_key =
Sys.(set_signal sigpipe Signal_ignore) ; Sys.(set_signal sigpipe Signal_ignore) ;
let dir = Fpath.v dir in let dir = Fpath.v dir in
@ -202,6 +223,7 @@ let jump _ dir cacert cert priv_key =
| None -> () | None -> ()
| Some s -> Lwt.async (fun () -> read_stats state s)) ; | Some s -> Lwt.async (fun () -> read_stats state s)) ;
Lwt.async (fun () -> read_log state l) ; Lwt.async (fun () -> read_log state l) ;
Lwt.async stats_loop ;
let rec loop () = let rec loop () =
Lwt.catch (fun () -> Lwt.catch (fun () ->
Lwt_unix.accept socket >>= fun (fd, addr) -> Lwt_unix.accept socket >>= fun (fd, addr) ->