Merge pull request #209 from lindig/CA-285213

CA-285213 add error logging to memory interface

Author: mseri

gpumon/gpumon_interface.ml

@@ -15,6 +15,9 @@
 open Rpc
 open Idl
 
+module D = Debug.Make(struct let name = "gpumon_interface" end)
+open D
+
 let service_name = "gpumon"
 let queue_name = Xcp_service.common_prefix ^ service_name
 let xml_path = "/var/xapi/" ^ service_name
@@ -73,14 +76,32 @@ type gpu_errors =
 
 exception Gpumon_error of gpu_errors
 
+let () = (* register printer *)
+  let sprintf = Printf.sprintf in
+  let string_of_error e =
+    Rpcmarshal.marshal gpu_errors.Rpc.Types.ty e |> Rpc.to_string in
+  let printer = function
+    | Gpumon_error e ->
+        Some (sprintf "Gpumon_interface.Gpumon_error(%s)" (string_of_error e))
+    | _ -> None in
+  Printexc.register_printer printer
+
 (** Error handler *)
-let gpu_err = Error.{
-    def = gpu_errors;
-    raiser = (fun e -> raise (Gpumon_error e));
-    matcher = (function
-        | Gpumon_error e -> Some e
-        | e -> Some (Internal_error (Printexc.to_string e)))
-  }
+let gpu_err = Error.
+    { def = gpu_errors
+    ; raiser = (fun e ->
+      log_backtrace ();
+      let exn = Gpumon_error e in
+      error "%s (%s)" (Printexc.to_string exn) __LOC__;
+      raise exn)
+    ; matcher = (function
+      | Gpumon_error e as exn ->
+          error "%s (%s)" (Printexc.to_string exn) __LOC__;
+            Some e
+      | exn ->
+          error "%s (%s)" (Printexc.to_string exn) __LOC__;
+            Some (Internal_error (Printexc.to_string exn)))
+    }
 
 (** Functor to autogenerate API calls *)
 module RPC_API(R : RPC) = struct

memory/memory_interface.ml

@@ -17,6 +17,9 @@
 open Rpc
 open Idl
 
+module D = Debug.Make(struct let name = "memory_interface" end)
+open D
+
 let service_name = "memory"
 let queue_name = Xcp_service.common_prefix ^ service_name
 let json_path = "/var/xapi/memory.json"
@@ -75,13 +78,31 @@ type errors =
 
 exception MemoryError of errors
 
-let err = Error.{
-    def = errors;
-    raiser = (fun e -> raise (MemoryError e));
-    matcher = (function
-        | MemoryError e -> Some e
-        | e -> Some (Internal_error (Printexc.to_string e)))
-  }
+let () = (* register printer for MemoryError *)
+  let sprintf = Printf.sprintf in
+  let string_of_error e =
+    Rpcmarshal.marshal errors.Rpc.Types.ty e |> Rpc.to_string in
+  let printer = function
+    | MemoryError e ->
+        Some (sprintf "Memory_interface.Memory_error(%s)" (string_of_error e))
+    | _ -> None in
+  Printexc.register_printer printer
+
+let err = Error.
+    { def = errors
+    ; raiser = (fun e ->
+      log_backtrace ();
+      let exn = MemoryError e in
+      error "%s (%s)" (Printexc.to_string exn) __LOC__;
+      raise exn)
+    ; matcher = (function
+      | MemoryError e as exn ->
+          error "%s (%s)" (Printexc.to_string exn) __LOC__;
+            Some e
+      | exn ->
+          error "%s (%s)" (Printexc.to_string exn) __LOC__;
+            Some (Internal_error (Printexc.to_string exn)))
+    }
 
 type debug_info = string
 [@@doc ["An uninterpreted string associated with the operation."]]

network/network_interface.ml

@@ -14,6 +14,9 @@
 open Rpc
 open Idl
 
+module D = Debug.Make(struct let name = "network_interface" end)
+open D
+
 (** {2 Helper functions} *)
 
 let service_name = "networkd"
@@ -224,13 +227,31 @@ type errors =
 
 exception Network_error of errors
 
-let err = Error.{
-    def = errors;
-    raiser = (function | e -> raise (Network_error e));
-    matcher = (function
-        | Network_error e -> Some e
-        | e -> Some (Internal_error (Printexc.to_string e)))
-  }
+let () = (* register printer *)
+  let sprintf = Printf.sprintf in
+  let string_of_error e =
+    Rpcmarshal.marshal errors.Rpc.Types.ty e |> Rpc.to_string in
+  let printer = function
+    | Network_error e ->
+        Some (sprintf "Network_interface.Network_error(%s)" (string_of_error e))
+    | _ -> None in
+  Printexc.register_printer printer
+
+let err = Error.
+    { def = errors
+    ; raiser = (fun e ->
+      log_backtrace ();
+      let exn = Network_error e in
+      error "%s (%s)" (Printexc.to_string exn) __LOC__;
+      raise exn)
+    ; matcher = (function
+      | Network_error e as exn ->
+          error "%s (%s)" (Printexc.to_string exn) __LOC__;
+            Some e
+      | exn ->
+          error "%s (%s)" (Printexc.to_string exn) __LOC__;
+            Some (Internal_error (Printexc.to_string exn)))
+    }
 
 (** {2 API functions} *)
 

v6/v6_interface.ml

@@ -18,6 +18,9 @@
 open Rpc
 open Idl
 
+module D = Debug.Make(struct let name = "v6_interface" end)
+open D
+
 let service_name = "v6d"
 let queue_name = ref (Xcp_service.common_prefix ^ service_name)
 let default_sockets_dir = "/var/lib/xcp"
@@ -91,15 +94,33 @@ type errors =
 exception V6_error of errors
 [@@deriving rpcty]
 
-(** handle exception generation and raising *)
-let err = Error.{
-    def = errors;
-    raiser = (fun e -> raise (V6_error e));
-    matcher = (function
-        | V6_error e -> Some e
-        | e -> Some (Internal_error (Printexc.to_string e)))
-  }
 
+let () = (* register printer *)
+  let sprintf = Printf.sprintf in
+  let string_of_error e =
+    Rpcmarshal.marshal errors.Rpc.Types.ty e |> Rpc.to_string in
+  let printer = function
+    | V6_error e ->
+        Some (sprintf "V6_interface.V6_error(%s)" (string_of_error e))
+    | _ -> None in
+  Printexc.register_printer printer
+
+(** handle exception generation and raising *)
+let err = Error.
+    { def = errors
+    ; raiser = (fun e ->
+      log_backtrace ();
+      let exn = V6_error e in
+      error "%s (%s)" (Printexc.to_string exn) __LOC__;
+      raise exn)
+    ; matcher = (function
+      | V6_error e as exn ->
+          error "%s (%s)" (Printexc.to_string exn) __LOC__;
+            Some e
+      | exn ->
+          error "%s (%s)" (Printexc.to_string exn) __LOC__;
+            Some (Internal_error (Printexc.to_string exn)))
+    }
 
 (** functor to autogenerate code using PPX *)
 module RPC_API(R : RPC) = struct