Fix backtraces in xenopsd-xc

A failing HOST.stat call logged just the exception, but not the
backtrace:
```
Sep  1 10:55:07 localhost xenopsd-xc: [error||72 ||backtrace] dbsync (update_env) R:a771d46f95c9 failed with exception Xenctrlext.Unix_error(57, "105: No buffer space availa
ble")
Sep  1 10:55:07 localhost xenopsd-xc: [error||72 ||backtrace] Raised Xenctrlext.Unix_error(57, "105: No buffer space available")
Sep  1 10:55:07 localhost xenopsd-xc: [error||72 ||backtrace] 1/1 xenopsd-xc Raised at file (Thread 72 has no backtrace table. Was with_backtraces called?, line 0
Sep  1 10:55:07 localhost xenopsd-xc: [error||72 ||backtrace]
```

Although with_backtraces was definitely called by
Debug.with_thread_associated:
```
    let stat _ dbg =
      Debug.with_thread_associated dbg
        (fun () ->
          debug "HOST.stat" ;
          let module B = (val get_backend () : S) in
          B.HOST.stat ())
        ()
```

This is because `with_backtraces` removes the thread-local backtrace
table that it has created on exit and returns an exception together with
its backtrace.
The backtrace was getting ignored, and re-queried in
Debug.log_backtrace_exn.
However that only works if Debug.with_* calls are nested.

Fix this so we always use the backtrace if available instead of querying
it.

log_backtrace can also be called externally, so make sure we still
attempt to retrieve the backtrace from the exception if the backtrace is
empty.

After the fix we now get a proper backtrace:
```
Sep  1 13:47:07 localhost xenopsd-xc: [error||44 ||backtrace] dbsync (update_env) R:531918011f4b failed with exception Xenctrlext.Unix_error(57, "105: No buffer space availa
ble")
Sep  1 13:47:07 localhost xenopsd-xc: [error||44 ||backtrace] Raised Xenctrlext.Unix_error(57, "105: No buffer space available")
Sep  1 13:47:07 localhost xenopsd-xc: [error||44 ||backtrace] 1/3 xenopsd-xc Raised at file xenopsd/xc/xenops_server_xen.ml, line 834
Sep  1 13:47:07 localhost xenopsd-xc: [error||44 ||backtrace] 2/3 xenopsd-xc Called from file xenopsd/xc/xenops_server_xen.ml, line 930
Sep  1 13:47:07 localhost xenopsd-xc: [error||44 ||backtrace] 3/3 xenopsd-xc Called from file xapi-idl/lib/debug.ml, line 220
Sep  1 13:47:07 localhost xenopsd-xc: [error||44 ||backtrace]
Sep  1 13:47:07 localhost xenopsd-xc: [error||44 ||xenops_interface] Xenctrlext.Unix_error(57, "105: No buffer space available") (File "xapi-idl/xen/xenops_interface.ml", li
ne 168, characters 51-58)
Sep  1 13:47:07 localhost xapi: [error||0 |dbsync (update_env) R:531918011f4b|xenops_interface] Xenops_interface.Xenopsd_error([S(Internal_error);S(Xenctrlext.Unix_error(57,
 "105: No buffer space available"))]) (File "xen/xenops_interface.ml", line 160, characters 49-56)
```

Signed-off-by: Edwin Török <[email protected]>

Author: edwintorok

lib/debug.ml

@@ -191,19 +191,34 @@ let rec split_c c str =
     :: split_c c (String.sub str (i + 1) (String.length str - i - 1))
   with Not_found -> [str]
 
-let log_backtrace_exn ?(level = Syslog.Err) ?(msg = "error") exn _bt =
-  Backtrace.is_important exn ;
-  let all = split_c '\n' Backtrace.(to_string_hum (remove exn)) in
+let log_backtrace_exn ?(level = Syslog.Err) ?(msg = "error") exn bt =
+  (* We already got the backtrace in the `bt` argument when called from with_thread_associated.
+     Log that, and remove `exn` from the backtraces table.
+     If with_backtraces was not nested then looking at `bt` is the only way to get
+     a proper backtrace, otherwise exiting from `with_backtraces` would've removed the backtrace
+     from the thread-local backtraces table, and we'd always just log a message complaining about
+     with_backtraces not being called, which is not true because it was.
+  *)
+  let bt' = Backtrace.remove exn in
+  (* bt could be empty, but bt' would contain a non-empty warning, so compare 'bt' here *)
+  let bt = if bt = Backtrace.empty then bt' else bt in
+  let all = split_c '\n' Backtrace.(to_string_hum bt) in
   (* Write to the log line at a time *)
   output_log "backtrace" level msg
     (Printf.sprintf "Raised %s" (Printexc.to_string exn)) ;
   List.iter (output_log "backtrace" level msg) all
 
-let log_backtrace e bt = log_backtrace_exn e bt
+let log_backtrace_internal ?level ?msg e _bt =
+ Backtrace.is_important e;
+ log_backtrace_exn ?level ?msg e (Backtrace.remove e)
+
+let log_backtrace e bt = log_backtrace_internal e bt
 
 let with_thread_associated task f x =
   ThreadLocalTable.add tasks task ;
-  let result = Backtrace.with_backtraces (fun () -> f x) in
+  let result = Backtrace.with_backtraces (fun () ->
+	try f x
+	with e -> Backtrace.is_important e; raise e) in
   ThreadLocalTable.remove tasks ;
   match result with
   | `Ok result ->
@@ -214,7 +229,7 @@ let with_thread_associated task f x =
       output_log "backtrace" Syslog.Err "error"
         (Printf.sprintf "%s failed with exception %s" task
            (Printexc.to_string exn)) ;
-      log_backtrace exn bt ;
+      log_backtrace_exn exn bt ;
       raise exn
 
 let with_thread_named name f x =
@@ -299,5 +314,5 @@ functor
 
     let log_and_ignore_exn f =
       try f ()
-      with e -> log_backtrace_exn ~level:Syslog.Debug ~msg:"debug" e ()
+      with e -> log_backtrace_internal ~level:Syslog.Debug ~msg:"debug" e ()
   end