Merge pull request #221 from talex5/solver-leak

Enable logging in the solver process and fix ref leak

service/logging.ml

@@ -28,7 +28,7 @@ let reporter =
     let src = Logs.Src.name src in
     Metrics.inc_messages level src;
     msgf @@ fun ?header ?tags:_ fmt ->
-    Fmt.kpf k Fmt.stdout ("%a %a %a @[" ^^ fmt ^^ "@]@.")
+    Fmt.kpf k Fmt.stderr ("%a %a %a @[" ^^ fmt ^^ "@]@.")
       pp_timestamp (Unix.gettimeofday ())
       Fmt.(styled `Magenta string) (Printf.sprintf "%14s" src)
       Logs_fmt.pp_header (level, header)

solver/main.ml

@@ -2,6 +2,28 @@ open Lwt.Infix
 
 let n_workers = 20
 
+let pp_timestamp f x =
+  let open Unix in
+  let tm = localtime x in
+  Fmt.pf f "%04d-%02d-%02d %02d:%02d.%02d" (tm.tm_year + 1900) (tm.tm_mon + 1)
+    tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec
+
+let reporter =
+  let report src level ~over k msgf =
+    let k _ = over (); k () in
+    let src = Logs.Src.name src in
+    msgf @@ fun ?header ?tags:_ fmt ->
+    Fmt.kpf k Fmt.stderr ("%a %a %a @[" ^^ fmt ^^ "@]@.")
+      pp_timestamp (Unix.gettimeofday ())
+      Fmt.(styled `Magenta string) (Printf.sprintf "%14s" src)
+      Logs_fmt.pp_header (level, header)
+  in
+  { Logs.report = report }
+
+let () =
+  Logs.(set_level (Some Warning));
+  Logs.set_reporter reporter
+
 let export service ~on:socket =
   let restore = Capnp_rpc_net.Restorer.single (Capnp_rpc_net.Restorer.Id.public "solver") service in
   let switch = Lwt_switch.create () in
@@ -11,7 +33,12 @@ let export service ~on:socket =
                 ~switch
   in
   let _ : Capnp_rpc_unix.CapTP.t = Capnp_rpc_unix.CapTP.connect ~restore stdin in
-  fst (Lwt.wait ())
+  let crashed, set_crashed = Lwt.wait () in
+  Lwt_switch.add_hook_or_exec (Some switch) (fun () ->
+      Lwt.wakeup_exn set_crashed (Failure "Capnp switch turned off");
+      Lwt.return_unit
+    ) >>= fun () ->
+  crashed
 
 let () =
   match Sys.argv with

solver/service.ml

@@ -140,10 +140,11 @@ let v ~n_workers ~create_worker =
       match log with
       | None -> Service.fail "Missing log argument!"
       | Some log ->
+        Capnp_rpc_lwt.Service.return_lwt @@ fun () ->
+        Capability.with_ref log @@ fun log ->
         match Worker.Solve_request.of_yojson (Yojson.Safe.from_string request) with
-        | Error msg -> Service.fail "Bad JSON in request: %s" msg
+        | Error msg -> Lwt_result.fail (`Capnp (Capnp_rpc.Error.exn "Bad JSON in request: %s" msg))
         | Ok request ->
-          Capnp_rpc_lwt.Service.return_lwt @@ fun () ->
           Lwt.catch
             (fun () -> handle t ~log request >|= Result.ok)
             (function