feat: introduce logger lifecycle (#97)

This change makes the Logger application startup process _block_ until
the logger is ready to take in requests. This means applications relying
on the logger will take a tiny bit longer to boot, but we can guarantee
that the log requests will not be dropped because of process spawn
order.

Close #82

riot/lib/logger/logger.ml

@@ -3,6 +3,7 @@ module Log = Riot_runtime.Log
 open Global
 
 type opts = { print_source : bool; print_time : bool; color_output : bool }
+type config = { opts : opts; started_by : Riot_runtime.Core.Pid.t }
 
 type ('a, 'b) logger_format =
  (('a, Format.formatter, unit, 'b) format4 -> 'a) -> 'b

riot/lib/logger_app.ml

@@ -5,6 +5,8 @@ open Logger.Make (struct
  let namespace = [ "riot"; "logger" ]
 end)
 
+type Message.t += Logger_ready
+
 module Formatter = struct
  type Message.t += Log of log
 
@@ -47,7 +49,8 @@ module Formatter = struct
  let pid =
  spawn_link (fun () ->
  Process.flag (Priority High);
- formatter_loop config)
+ send config.started_by Logger_ready;
+ formatter_loop config.opts)
  in
  set_on_log (fun log -> send pid (Log log));
  Ok pid
@@ -59,5 +62,12 @@ let default_opts =
  { print_time = true; print_source = false; color_output = true }
 
 let start () =
- let child_specs = [ Formatter.child_spec default_opts ] in
- Supervisor.start_link ~child_specs ()
+ let this = self () in
+ let config = { opts = default_opts; started_by = this } in
+ let child_specs = [ Formatter.child_spec config ] in
+ let result = Supervisor.start_link ~child_specs () in
+ let `ready =
+ let selector msg = if msg = Logger_ready then `select `ready else `skip in
+ receive ~selector ()
+ in
+ result

riot/lib/ssl.ml

@@ -100,28 +100,28 @@ module Tls_unix = struct
  let handle tls cs =
  match Tls.Engine.handle_tls tls cs with
  | Ok (state', eof, `Response resp, `Data data) ->
- trace (fun f -> f "tls.read_react->ok");
- let state' =
- match eof with
- | Some `Eof -> `Eof
- | _ -> inject_state state' t.state
- in
- t.state <- state';
- Option.iter (try_write_t t) resp;
- data
+  trace (fun f -> f "tls.read_react->ok");
+  let state' =
+  match eof with
+  | Some `Eof -> `Eof
+  | _ -> inject_state state' t.state
+  in
+  t.state <- state';
+  Option.iter (try_write_t t) resp;
+  data
  | Error (fail, `Response resp) ->
- let state' =
- match fail with
- | `Alert a ->
- trace (fun f -> f "tls.read_react->alert");
- `Error (Tls_alert a)
- | f ->
- trace (fun f -> f "tls.read_react->error");
- `Error (Tls_failure f)
- in
- t.state <- state';
- write_t t resp;
- read_react t
+  let state' =
+  match fail with
+  | `Alert a ->
+  trace (fun f -> f "tls.read_react->alert");
+  `Error (Tls_alert a)
+  | f ->
+  trace (fun f -> f "tls.read_react->error");
+  `Error (Tls_failure f)
+  in
+  t.state <- state';
+  write_t t resp;
+  read_react t
  in
 
  match t.state with