albatrossd: style cleanups
This commit is contained in:
parent
50958a32f5
commit
ccf3cae68c
|
@ -146,36 +146,32 @@ let jump _ influx tmpdir dbdir retries enable_stats =
|
||||||
| Ok old_unikernels ->
|
| Ok old_unikernels ->
|
||||||
Lwt_main.run
|
Lwt_main.run
|
||||||
(let rec unix_connect ~retries s =
|
(let rec unix_connect ~retries s =
|
||||||
(Vmm_lwt.connect Lwt_unix.PF_UNIX (Lwt_unix.ADDR_UNIX (socket_path s)) >>= function
|
let path = socket_path s in
|
||||||
| Some x -> Lwt.return (Some x)
|
Vmm_lwt.connect Lwt_unix.PF_UNIX (Lwt_unix.ADDR_UNIX path) >>= function
|
||||||
|
| Some x -> Lwt.return x
|
||||||
| None when (retries <> 0) ->
|
| None when (retries <> 0) ->
|
||||||
(Logs.err (fun m -> m "unable to connect to %s, retrying in 5 seconds" (socket_path s));
|
Logs.err (fun m -> m "unable to connect to %a, retrying in 5 seconds"
|
||||||
Lwt_unix.sleep 5.0 >>= fun () ->
|
pp_socket s);
|
||||||
unix_connect ~retries:(retries - 1) s)
|
Lwt_unix.sleep 5.0 >>= fun () ->
|
||||||
| None -> Lwt.return_none)
|
unix_connect ~retries:(retries - 1) s
|
||||||
|
| None -> Lwt.fail_with (Fmt.strf "cannot connect to %a" pp_socket s)
|
||||||
in
|
in
|
||||||
init_influx "albatross" influx;
|
init_influx "albatross" influx;
|
||||||
|
unix_connect ~retries `Log >>= fun l ->
|
||||||
(unix_connect ~retries `Log >|= function
|
unix_connect ~retries `Console >>= fun c ->
|
||||||
| None -> invalid_arg "cannot connect to log socket"
|
|
||||||
| Some l -> l) >>= fun l ->
|
|
||||||
|
|
||||||
(unix_connect ~retries `Console >|= function
|
|
||||||
| None -> invalid_arg "cannot connect to console socket"
|
|
||||||
| Some c -> c) >>= fun c ->
|
|
||||||
|
|
||||||
(if enable_stats then
|
(if enable_stats then
|
||||||
(unix_connect ~retries `Stats >|= function
|
unix_connect ~retries `Stats >|= fun s ->
|
||||||
| None -> invalid_arg "cannot connect to stats socket"
|
Some s
|
||||||
| Some c -> Some c)
|
else
|
||||||
else
|
Lwt.return_none) >>= fun s ->
|
||||||
Lwt.return_none)
|
Lwt.catch
|
||||||
>>= fun s ->
|
(fun () -> Vmm_lwt.server_socket `Vmmd)
|
||||||
|
(fun e ->
|
||||||
Lwt.catch (fun () ->
|
let str =
|
||||||
Vmm_lwt.server_socket `Vmmd)
|
Fmt.strf "unable to create server socket %a: %s"
|
||||||
(fun _ -> invalid_arg ("unable to create server socket " ^ (socket_path `Vmmd)))
|
pp_socket `Vmmd (Printexc.to_string e)
|
||||||
>>= fun ss ->
|
in
|
||||||
|
invalid_arg str) >>= fun ss ->
|
||||||
let self_destruct_mutex = Lwt_mutex.create () in
|
let self_destruct_mutex = Lwt_mutex.create () in
|
||||||
let self_destruct () =
|
let self_destruct () =
|
||||||
Lwt_mutex.with_lock self_destruct_mutex (fun () ->
|
Lwt_mutex.with_lock self_destruct_mutex (fun () ->
|
||||||
|
@ -188,20 +184,21 @@ let jump _ influx tmpdir dbdir retries enable_stats =
|
||||||
Lwt.return_unit) >>= fun () ->
|
Lwt.return_unit) >>= fun () ->
|
||||||
Vmm_lwt.safe_close ss)
|
Vmm_lwt.safe_close ss)
|
||||||
in
|
in
|
||||||
Sys.(set_signal sigterm (Signal_handle (fun _ -> Lwt.async self_destruct)));
|
Sys.(set_signal sigterm
|
||||||
|
(Signal_handle (fun _ -> Lwt.async self_destruct)));
|
||||||
let log_out txt wire = write_reply "log" l txt wire >|= fun _ -> ()
|
let log_out txt wire = write_reply "log" l txt wire >|= fun _ -> ()
|
||||||
and cons_out = write_reply "cons" c
|
and cons_out = write_reply "cons" c
|
||||||
and stat_out txt wire = match s with
|
and stat_out txt wire = match s with
|
||||||
| None -> Logs.info (fun m -> m "ignoring stat %s %a" txt Vmm_commands.pp_wire wire) ; Lwt.return_unit
|
| None ->
|
||||||
|
Logs.info (fun m -> m "ignoring stat %s %a" txt
|
||||||
|
Vmm_commands.pp_wire wire);
|
||||||
|
Lwt.return_unit
|
||||||
| Some s -> write_reply "stat" s txt wire >|= fun _ -> ()
|
| Some s -> write_reply "stat" s txt wire >|= fun _ -> ()
|
||||||
in
|
in
|
||||||
|
|
||||||
Lwt_list.iter_s (fun (name, config) ->
|
Lwt_list.iter_s (fun (name, config) ->
|
||||||
Lwt_mutex.with_lock create_lock (fun () ->
|
Lwt_mutex.with_lock create_lock (fun () ->
|
||||||
create stat_out log_out cons_out stub_data_out name config))
|
create stat_out log_out cons_out stub_data_out name config))
|
||||||
(Vmm_trie.all old_unikernels) >>= fun () ->
|
(Vmm_trie.all old_unikernels) >>= fun () ->
|
||||||
|
|
||||||
Lwt.catch (fun () ->
|
Lwt.catch (fun () ->
|
||||||
let rec loop () =
|
let rec loop () =
|
||||||
Lwt_unix.accept ss >>= fun (fd, addr) ->
|
Lwt_unix.accept ss >>= fun (fd, addr) ->
|
||||||
|
@ -214,7 +211,8 @@ let jump _ influx tmpdir dbdir retries enable_stats =
|
||||||
in
|
in
|
||||||
loop ())
|
loop ())
|
||||||
(fun e ->
|
(fun e ->
|
||||||
Logs.err (fun m -> m "exception %s, shutting down" (Printexc.to_string e));
|
Logs.err (fun m -> m "exception %s, shutting down"
|
||||||
|
(Printexc.to_string e));
|
||||||
self_destruct ()))
|
self_destruct ()))
|
||||||
|
|
||||||
open Cmdliner
|
open Cmdliner
|
||||||
|
|
Loading…
Reference in a new issue