wip

ocaml/libs/log/backtrace_interop.ml

@@ -0,0 +1,50 @@
+(*
+ * Copyright (C) 2006-2014 Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+open Sexplib0.Sexp_conv
+
+type frame = {process: string; filename: string; line: int} [@@deriving sexp_of]
+
+type t = frame list [@@deriving sexp_of]
+
+let to_string_hum xs =
+  let xs' = List.length xs in
+  let results = Buffer.create 10 in
+  let rec loop first_line i = function
+    | [] ->
+        Buffer.contents results
+    | x :: xs ->
+        Buffer.add_string results
+          (Printf.sprintf "%d/%d %s %s file %s, line %d" i xs' x.process
+             (if first_line then "Raised at" else "Called from")
+             x.filename x.line
+          ) ;
+        Buffer.add_string results "\n" ;
+        loop false (i + 1) xs
+  in
+  loop true 1 xs
+
+(* This matches xapi.py:exception *)
+type error = {
+    error: string
+  ; (* Python json.dumps and rpclib are not very friendly *)
+    files: string list
+  ; lines: int list
+}
+[@@deriving rpc]
+
+let of_json source_name txt =
+  txt |> Jsonrpc.of_string |> error_of_rpc |> fun e ->
+  List.combine e.files e.lines
+  |> List.map (fun (filename, line) -> {process= source_name; filename; line})

ocaml/libs/log/backtrace_interop.mli

@@ -0,0 +1,9 @@
+(** {2 Interop with other languages}
+    This allows backtraces from other languages (e.g. python) to be converted
+    into OCaml-style backtraces. *)
+
+type frame = {process: string; filename: string; line: int} [@@deriving sexp_of]
+
+val of_json : string -> string -> frame list
+(** [of_json source_name json]: unmarshals a json-format backtrace from
+    [source_name] *)

ocaml/libs/log/dune

@@ -8,9 +8,16 @@
    astring
    fmt
    mtime
+   rpclib.core
+   rpclib.json
    logs
    threads.posix
    xapi-backtrace
  )
+ (preprocess
+   (per_module
+    ((pps ppx_deriving_rpc ppx_sexp_conv) Backtrace_interop)
+  )
+ )
  (wrapped false)
 )