message-forwrding: keep backtraces when reraising an exception (#6995)

A few functions in message_forwarding need to do some cleanup when
encountering an exception, but in doing so, the original backtrace is
lost. This makes it difficult to track down the original location that
raised
 the exception.

I've considered other options instead of calling Backtrace.is_important:
- Call `Backtrace.reraise e e`: this is more expensive than it needs to
  be.
- Create a new function that can be easily used: This is awkward to
  backport, and in my attempts the resulting code was not great to read.

So I ended up with the compromise of using Backtrace.is_important, which
does exactly what's needed here, even though it's difficult to enforce
correctly across the codebase.

Author: psafont

ocaml/xapi/message_forwarding.ml

@@ -208,6 +208,7 @@ let iter_with_drop ?(doc = "performing unknown operation") f xs =
 let log_exn ?(doc = "performing unknown operation") f x =
   try f x
   with e ->
+    Backtrace.is_important e ;
     debug "Caught exception while %s in message forwarder: %s" doc
       (ExnHelper.string_of_exn e) ;
     raise e
@@ -332,9 +333,10 @@ functor
     let tolerate_connection_loss fn success timeout =
       try fn ()
       with
-      | Api_errors.Server_error (ercode, params)
+      | Api_errors.Server_error (ercode, _) as e
       when ercode = Api_errors.cannot_contact_host
       ->
+        Backtrace.is_important e ;
         debug
           "Lost connection with slave during call (expected). Waiting for \
            slave to come up again." ;
@@ -346,8 +348,7 @@ functor
         let rec poll i =
           match i with
           | 0 ->
-              raise (Api_errors.Server_error (ercode, params))
-              (* give up and re-raise exn *)
+              raise e (* give up and re-raise exn *)
           | i -> (
             match success () with
             | Some result ->
@@ -1311,6 +1312,7 @@ functor
             vbds ;
           vbds
         with e ->
+          Backtrace.is_important e ;
           debug "Caught exception marking VBD for %s on VM %s: %s" doc
             (Ref.string_of vm)
             (ExnHelper.string_of_exn e) ;
@@ -1492,6 +1494,7 @@ functor
             (Helpers.will_have_qemu ~__context ~self:vm) ;
           Xapi_network_sriov_helpers.reserve_sriov_vfs ~__context ~host ~vm
         with e ->
+          Backtrace.is_important e ;
           clear_vif_reservations ~__context ~vm ;
           clear_reservations ~__context ~vm ;
           raise e
@@ -1636,6 +1639,7 @@ functor
         ) ;
         try f ()
         with exn ->
+          Backtrace.is_important exn ;
           if !restore_old_values_on_error then (
             Db.VM.set_memory_dynamic_min ~__context ~self:vm
               ~value:old_dynamic_min ;
@@ -5215,6 +5219,7 @@ functor
                 (fun (vdi, op) -> mark_vdi ~__context ~vdi ~doc ~op)
                 vdi
             with e ->
+              Backtrace.is_important e ;
               Option.iter
                 (fun (sr, op) -> SR.unmark_sr ~__context ~sr ~doc ~op)
                 sr ;
@@ -6564,6 +6569,7 @@ functor
             -> (
               match rest with
               | [] ->
+                  Backtrace.is_important e ;
                   debug
                     "Ran out of hosts to try (and no cluster host on \
                      ourselves), reporting error" ;