[hack] Restore backtraces in server logs

Summary:
For a while now we've been getting useless backtraces in the server logs, e.g.
```
(Sys_error
"/tmp/hh_server/hhi_276b1297/hhi_lib__srcs/BuiltinEnum.hhi: Permission denied")
Raised at file "format.ml" (inlined), line 239, characters 35-52
Called from file "format.ml", line 465, characters 8-33
Called from file "format.ml", line 480, characters 6-24
```

The problem comes from here:
```
let with_exit_on_exception f =
  try f () with | x -> exit_on_exception x
```

The `exit_on_exception` routine does various things, and eventually calls `Hh_logger.exc`, which does various things and then does `Printexc.get_backtrace ()`. The problem is that `Printexc.get_backtrace` merely obtains the most recent contents of the **GLOBAL** "current backtrace" object. Therefore, if any of the "various things" happened to change the global backtrace object (which they did), then the trace printed by Hh_logger.exc will be useless (which it was).

In general, the only safe thing to do is to capture the backtrace AT THE MOMENT your 'with' block is invoked. It's not safe to invoke any function before that, unless you can guarantee that their implementations will never modify the global backtrace object.

I've changed things around to support this. I made `ServerUtils.with_exit_on_exception` capture the global backtrace as soon as it catches an exception. I've made this bubble all the way down into `Hh_logger.exc`.

There are still a load of places which obtain the current global backtrace object in a dodgy way. One of them is from the `Hh_logger.print_with_newline` method (which only has one caller). Several of them used to call `Hh_logger.exc`, which I've renamed to `Hh_logger.exc_with_dodgy_backtrace` to make clear. I didn't do an audit of the rest of the code and don't plan to.

Anyway, I've changed just the few places necessary to restore proper backtraces for server exceptions, in a way that's less robust. If we find other poor stacktraces in future, then we can fix those places too.

Reviewed By: dabek

Differential Revision: D10118184

fbshipit-source-id: 0f5ab9a11c52508c8d1cb9ee675262ae10948bc2

hack/procs/multiThreadedCall.ml

@@ -45,8 +45,8 @@ let call_id = ref 0
  * them is to log and exit. Setting on_exception handler allows you to do it
  * before any caller has a chance to catch the exception and attempt to handle
  * it. *)
-let nested_exception: exn option ref = ref None
-let on_exception_ref = ref (fun e -> nested_exception := Some e)
+let nested_exception: (exn * Utils.callstack) option ref = ref None
+let on_exception_ref = ref (fun (e,stack) -> nested_exception := Some (e, stack))
 
 let multi_threaded_call
   (type a) (type b) (type c) (type d)
@@ -106,7 +106,7 @@ let multi_threaded_call
           then env, decision, handlers else
         let env, decision = handler env in
         (* Re-raise the exception even if handler have caught and ignored it *)
-        Option.iter !nested_exception ~f:(fun x -> raise x);
+        Option.iter !nested_exception ~f:(fun (x, _stack) -> raise x);
         (* running a handler could have changed the handlers,
          * so need to regenerate them based on new environment *)
         let handlers = interrupt.handlers env in
@@ -186,7 +186,8 @@ let multi_threaded_call
     let () = nested_exception := None in
     dispatch (Some workers) handles (neutral, interrupt.env, interrupt.handlers interrupt.env)
   with e ->
-    !on_exception_ref e;
+    let stack = Utils.Callstack (Printexc.get_backtrace ()) in
+    !on_exception_ref (e, stack);
     raise e
 
 let call workers job merge neutral next =

hack/procs/multiThreadedCall.mli

@@ -53,4 +53,4 @@ val call_with_interrupt :
   'd interrupt_config ->
   'c * 'd * 'a list
 
-val on_exception : (exn -> unit) -> unit
+val on_exception : ((exn * Utils.callstack) -> unit) -> unit

hack/utils/hh_logger.ml

@@ -43,12 +43,15 @@ let print_duration name t =
   print_with_newline "%s: %f" name (t2 -. t);
   t2
 
-let exc ?(prefix="") e =
+let exc_with_dodgy_backtrace ?(prefix: string = "") (e: exn) : unit =
   (* TODO - delete this function and use call normal Hh_logger functions with ~exn *)
   print_with_newline "%s%s" prefix (Printexc.to_string e);
   Printexc.print_backtrace stderr;
   ()
 
+let exc ?(prefix: string = "") ~(stack: string) (e: exn) : unit =
+  print_with_newline "%s%s\n%s" prefix (Printexc.to_string e) stack
+
 module Level : sig
   type t =
     | Off

hack/watchman/watchman.ml

@@ -406,7 +406,7 @@ struct
 
   let with_crash_record_exn source f =
     Watchman_process.catch ~f ~catch:(fun e ->
-      Hh_logger.exc ~prefix:("Watchman " ^ source ^ ": ") e;
+      Hh_logger.exc_with_dodgy_backtrace ~prefix:("Watchman " ^ source ^ ": ") e;
       raise e
     )