CA-409628: add missing Backtrace.is_important

This shows how brittle the current Backtrace API is,
this was missing from a lot of places.

We have some better alternatives (`with_backtraces`,
or a `try_with` function) that'd guarantee that `important` is
always called in the right place, but that would be a more invasive change,
which will be done in a followup commit.

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

Author: edwintorok

ocaml/gencert/selfcert.ml

@@ -109,6 +109,7 @@ let generate_pub_priv_key length =
       let stdout, _stderr = call_openssl args in
       Ok stdout
     with e ->
+      Backtrace.is_important e ;
       let msg = "generating RSA key failed" in
       D.error "selfcert.ml: %s" msg ;
       Debug.log_backtrace e (Backtrace.get e) ;

ocaml/libs/http-lib/http_svr.ml

@@ -474,6 +474,7 @@ let read_request ?proxy_seen ~read_timeout ~total_timeout ~max_length fd =
     in
     (Some r, proxy)
   with e ->
+    Backtrace.is_important e ;
     D.warn "%s (%s)" (Printexc.to_string e) __LOC__ ;
     best_effort (fun () ->
         match e with

ocaml/libs/log/debug.ml

@@ -258,6 +258,10 @@ let with_thread_associated ?client ?(quiet = false) desc f x =
       (* This function is a top-level exception handler typically used on fresh
          threads. This is the last chance to do something with the backtrace *)
       if not quiet then (
+        (* It would seem that a Backtrace.is_important would be missing here.
+           But in fact it has actually been called in [let result] above,
+           so calling it again is not necessary.
+        *)
         output_log "backtrace" Syslog.Err "error"
           (Printf.sprintf "%s failed with exception %s" desc
              (Printexc.to_string exn)

ocaml/xapi/cancel_tasks.ml

@@ -21,6 +21,7 @@ open D
 let safe_wrapper n f x =
   try f x
   with e ->
+    Backtrace.is_important e ;
     debug "Caught exception while cancelling tasks (%s): %s" n
       (ExnHelper.string_of_exn e) ;
     Debug.log_backtrace e (Backtrace.get e)

ocaml/xapi/storage_access.ml

@@ -162,6 +162,7 @@ let on_xapi_start ~__context =
       | Message_switch_failure ->
           [] (* no more logging *)
       | e ->
+          Backtrace.is_important e ;
           error "Unexpected error querying the message switch: %s"
             (Printexc.to_string e) ;
           Debug.log_backtrace e (Backtrace.get e) ;

ocaml/xapi/xapi_extensions.ml

@@ -79,6 +79,7 @@ let call_extension rpc =
   | Api_errors.Server_error (code, params) ->
       API.response_of_failure code params
   | e ->
+      Backtrace.is_important e ;
       error "Unexpected exception calling extension %s: %s" rpc.Rpc.name
         (Printexc.to_string e) ;
       Debug.log_backtrace e (Backtrace.get e) ;

ocaml/xapi/xapi_pool.ml

@@ -1358,6 +1358,7 @@ let create_or_get_secret_on_master __context rpc session_id (_secret_ref, secret
 let protect_exn f x =
   try Some (f x)
   with e ->
+    Backtrace.is_important e ;
     debug "Ignoring exception: %s" (Printexc.to_string e) ;
     Debug.log_backtrace e (Backtrace.get e) ;
     None

ocaml/xcp-rrdd/bin/rrdd/rrdd_server.ml

@@ -692,10 +692,10 @@ module Plugin = struct
           (* reset skip counts *)
           payload
         with e -> (
+          Backtrace.is_important e ;
           incr_skip_count uid plugin ;
           (* increase skip count *)
           let log e =
-            Backtrace.is_important e ;
             info "Failed to process plugin metrics file: %s (%s)"
               (P.string_of_uid ~uid) (Printexc.to_string e) ;
             log_backtrace e