package current-albatross-deployer

  1. Overview
  2. Docs

Source file albatross_monitor.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
module Info = struct
  type t = { status : [ `Running | `Exited ] }

  let status t = t.status
end

let monitor ?(poll_rate = 10.)
    (deployment : Albatross_deploy.Deployed.t Current.t) =
  let open Current.Syntax in
  Current.component "Monitor status"
  |> let> deployment = deployment in
     let config = deployment.config in
     let name = config.id in
     let vmm_name = Vmm_core.Name.of_string name |> Result.get_ok in
     let ip = config.ip in
     let status = ref `Running in
     let set_and_refresh value refresh =
       if !status <> value then (
         status := value;
         refresh ())
     in
     let read () = Lwt_result.return { Info.status = !status } in
     let watch refresh =
       let open Lwt.Syntax in
       let stop = Lwt_condition.create () in
       let rec loop () =
         let* unikernel_info = Client.Albatross.show_unikernel vmm_name in
         match unikernel_info with
         | Ok [ (_, _info) ] ->
             set_and_refresh `Running refresh;
             let* () = Lwt_unix.sleep poll_rate in
             loop ()
         | Ok [] ->
             set_and_refresh `Exited refresh;
             let* () = Lwt_unix.sleep poll_rate in
             loop ()
         | _ -> Lwt.return_unit
       in

       Lwt.async (fun () -> Lwt.pick [ Lwt_condition.wait stop; loop () ]);
       Lwt.return (fun () ->
           Lwt_condition.signal stop ();
           Lwt.return_unit)
     in
     let pp f = Fmt.pf f "Monitor deployment %s on %a" name Ipaddr.V4.pp ip in

     Current.Monitor.create ~read ~watch ~pp |> Current.Monitor.get

let is_running (info : Info.t Current.t) =
  let open Current.Syntax in
  Current.component "is running"
  |> let> info = info in
     let result =
       if info.status = `Running then Ok () else Error (`Msg "not running")
     in
     Current_incr.const (result, None)