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

vmm_stats_lwt: accept command line option for interval

Browse source
This commit is contained in:
Hannes Mehnert 2018-04-03 22:49:00 +02:00
parent a0c0f39734
commit d9f8f10b04
1 changed files with 11 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
stats/vmm_stats_lwt.ml
View file

@ -42,18 +42,19 @@ let handle s addr () =
Vmm_stats.remove_all !t ; Vmm_stats.remove_all !t ;
t := Vmm_stats.empty () t := Vmm_stats.empty ()
let rec timer () = let rec timer interval () =
t := Vmm_stats.tick !t ; t := Vmm_stats.tick !t ;
Lwt_unix.sleep Duration.(to_f (of_sec 15)) >>= fun () -> Lwt_unix.sleep interval >>= fun () ->
timer () timer interval ()
let jump _ file = let jump _ file interval =
Sys.(set_signal sigpipe Signal_ignore) ; Sys.(set_signal sigpipe Signal_ignore) ;
let interval = Duration.(to_f (of_sec interval)) in
Lwt_main.run Lwt_main.run
(let s = Lwt_unix.(socket PF_UNIX SOCK_STREAM 0) in (let s = Lwt_unix.(socket PF_UNIX SOCK_STREAM 0) in
Lwt_unix.(Versioned.bind_2 s (ADDR_UNIX file)) >>= fun () -> Lwt_unix.(Versioned.bind_2 s (ADDR_UNIX file)) >>= fun () ->
Lwt_unix.listen s 1 ; Lwt_unix.listen s 1 ;
Lwt.async timer ; Lwt.async (timer interval) ;
let rec loop () = let rec loop () =
Lwt_unix.accept s >>= fun (cs, addr) -> Lwt_unix.accept s >>= fun (cs, addr) ->
Lwt.async (handle cs addr) ; Lwt.async (handle cs addr) ;
@ -77,8 +78,12 @@ let socket =
let doc = "Socket to listen onto" in let doc = "Socket to listen onto" in
Arg.(value & pos 0 string "" & info [] ~doc) Arg.(value & pos 0 string "" & info [] ~doc)
let interval =
let doc = "Interval between statistics gatherings (in seconds)" in
Arg.(value & opt int 15 & info [ "internval" ] ~doc)
let cmd = let cmd =
Term.(ret (const jump $ setup_log $ socket)), Term.(ret (const jump $ setup_log $ socket $ interval)),
Term.info "vmm_stats" ~version:"%%VERSION_NUM%%" Term.info "vmm_stats" ~version:"%%VERSION_NUM%%"
let () = match Term.eval cmd with `Ok () -> exit 0 | _ -> exit 1 let () = match Term.eval cmd with `Ok () -> exit 0 | _ -> exit 1