xenvmd, local allocator: log all the metadata updates on the rings

Signed-off-by: David Scott <[email protected]>

Author: David Scott

idl/log.ml

@@ -1,3 +1,27 @@
+open Sexplib.Std
+
+type traced_operation = [
+  | `Set of string * string * [ `Producer | `Consumer | `Suspend | `Suspend_ack ] * [ `Int64 of int64 | `Bool of bool ]
+  | `Get of string * string * [ `Producer | `Consumer | `Suspend | `Suspend_ack ] * [ `Int64 of int64 | `Bool of bool ]
+] with sexp
+type traced_operation_list = traced_operation list with sexp
+
 let debug fmt = Printf.ksprintf (fun s -> print_endline s) fmt
 let info  fmt = Printf.ksprintf (fun s -> print_endline s) fmt
 let error fmt = Printf.ksprintf (fun s -> print_endline s) fmt
+
+let trace ts =
+  let string_of_key = function
+  | `Producer -> "producer"
+  | `Consumer -> "consumer"
+  | `Suspend -> "suspend"
+  | `Suspend_ack -> "suspend_ack" in
+  let string_of_value = function
+  | `Int64 x -> Int64.to_string x
+  | `Bool b -> string_of_bool b in
+  let one = function
+  | `Set (_, queue, key, value) ->
+    Printf.sprintf "%s.%s := %s" queue (string_of_key key) (string_of_value value)
+  | `Get (__, queue, key, value) ->
+    Printf.sprintf "%s.%s == %s" queue (string_of_key key) (string_of_value value) in
+  info "%s" (String.concat ", " (List.map one ts))

test/common.ml

@@ -20,12 +20,6 @@ open Lwt
 (* Mock kernel devices so we can run as a regular user *)
 let use_mock = ref true
 
-module Log = struct
-  let debug fmt = Printf.ksprintf (fun s -> print_endline s) fmt
-  let info  fmt = Printf.ksprintf (fun s -> print_endline s) fmt
-  let error fmt = Printf.ksprintf (fun s -> print_endline s) fmt
-end
-
 module Time = struct
   type 'a io = 'a Lwt.t
   let sleep = Lwt_unix.sleep

xenvm-local-allocator/local_allocator.ml

@@ -384,7 +384,7 @@ let main use_mock config daemon socket journal fromLVM toLVM =
     ) >>= fun device ->
 
     (* We must replay the journal before resynchronising free blocks *)
-    J.start device perform
+    J.start ~client:"xenvm-local-allocator" ~name:"local allocator journal" device perform
     >>|= fun j ->
 
     FreePool.start config vg

xenvmd/xenvmd.ml

@@ -538,7 +538,7 @@ module FreePool = struct
       | `Error _ -> fatal_error_t ("open " ^ name)
       | `Ok x -> return x )
     >>= fun device ->
-    J.start device perform
+    J.start ~client:"xenvmd" ~name:"allocation journal" device perform
     >>|= fun j' ->
     journal := Some j';
     return ()