From 976c571c65a650e5ac62cb90bca35cec8167ec42 Mon Sep 17 00:00:00 2001 From: David Scott Date: Mon, 15 Jun 2015 12:53:26 +0000 Subject: [PATCH 1/4] Host.all: return debug_info from the rings This shows the full detail to make debugging easier. This requires a change to mirage/shared-block-ring. Signed-off-by: David Scott --- idl/xenvm_interface.ml | 1 + xenvm/xenvm.ml | 2 +- xenvmd/xenvmd.ml | 12 ++++++++++-- 3 files changed, 12 insertions(+), 3 deletions(-) diff --git a/idl/xenvm_interface.ml b/idl/xenvm_interface.ml index 9600779..f25543e 100644 --- a/idl/xenvm_interface.ml +++ b/idl/xenvm_interface.ml @@ -42,6 +42,7 @@ external shutdown : unit -> int = "" type queue = { lv: string; suspended: bool; + debug_info: (string * string) list; } type connection_state = diff --git a/xenvm/xenvm.ml b/xenvm/xenvm.ml index 0d8d81e..18c2fdd 100644 --- a/xenvm/xenvm.ml +++ b/xenvm/xenvm.ml @@ -112,7 +112,7 @@ let host_list copts (vg_name,_) = let table_of_queue q = [ [ "lv"; q.lv ]; [ "suspended"; string_of_bool q.suspended ] - ] in + ] @ (List.map (fun (k, v) -> [ k; v ]) q.debug_info) in let table_of_host h = let connection_state = [ "state"; match h.connection_state with Some x -> Jsonrpc.to_string (rpc_of_connection_state x) | None -> "None" ] in let fromLVM = add_prefix "fromLVM" (table_of_queue h.fromLVM) in diff --git a/xenvmd/xenvmd.ml b/xenvmd/xenvmd.ml index 4ff86e9..196686d 100644 --- a/xenvmd/xenvmd.ml +++ b/xenvmd/xenvmd.ml @@ -47,6 +47,8 @@ module ToLVM = struct fatal_error "attaching to ToLVM queue" (R.Consumer.attach ~queue:(name ^ " ToLVM Consumer") ~client:"xenvmd" ~disk ()) let state t = fatal_error "querying ToLVM state" (R.Consumer.state t) + let debug_info t = + fatal_error "querying ToLVM debug_info" (R.Consumer.debug_info t) let rec suspend t = R.Consumer.suspend t >>= function @@ -118,6 +120,8 @@ module FromLVM = struct >>= fun x -> return (!initial_state, x) let state t = fatal_error "FromLVM.state" (R.Producer.state t) + let debug_info t = + fatal_error "querying FromLVM debug_info" (R.Producer.debug_info t) let rec push t item = R.Producer.push ~t ~item () >>= function | `Error (`Msg x) -> fatal_error_t (Printf.sprintf "Error pushing to the FromLVM queue: %s" x) | `Error `Retry -> @@ -435,13 +439,17 @@ module VolumeManager = struct ( ToLVM.state t >>= function | `Suspended -> return true | `Running -> return false ) >>= fun suspended -> - let toLVM = { Xenvm_interface.lv; suspended } in + ToLVM.debug_info t + >>= fun debug_info -> + let toLVM = { Xenvm_interface.lv; suspended; debug_info } in let lv = fromLVM name in let t = List.assoc name !from_LVMs in ( FromLVM.state t >>= function | `Suspended -> return true | `Running -> return false ) >>= fun suspended -> - let fromLVM = { Xenvm_interface.lv; suspended } in + FromLVM.debug_info t + >>= fun debug_info -> + let fromLVM = { Xenvm_interface.lv; suspended; debug_info } in read (fun vg -> try let lv = Lvm.Vg.LVs.find_by_name (freeLVM name) vg.Lvm.Vg.lvs in From ee386d635d04fe1e3afcf5fb1ed2d888fa63e89f Mon Sep 17 00:00:00 2001 From: David Scott Date: Tue, 16 Jun 2015 09:47:52 +0000 Subject: [PATCH 2/4] xenvmd: remove the periodic 'sleeping' debug prints These are less useful than the metadata tracing will be. Signed-off-by: David Scott --- xenvmd/xenvmd.ml | 9 --------- 1 file changed, 9 deletions(-) diff --git a/xenvmd/xenvmd.ml b/xenvmd/xenvmd.ml index 196686d..87e8116 100644 --- a/xenvmd/xenvmd.ml +++ b/xenvmd/xenvmd.ml @@ -55,7 +55,6 @@ module ToLVM = struct | `Error (`Msg msg) -> fatal_error_t msg | `Error `Suspended -> return () | `Error `Retry -> - debug "ToLVM.suspend got `Retry; sleeping"; Lwt_unix.sleep 5. >>= fun () -> suspend t @@ -65,7 +64,6 @@ module ToLVM = struct >>= function | `Error _ -> fatal_error_t "reading state of ToLVM" | `Ok `Running -> - debug "ToLVM.suspend got `Running; sleeping"; Lwt_unix.sleep 5. >>= fun () -> wait () @@ -76,7 +74,6 @@ module ToLVM = struct >>= function | `Error (`Msg msg) -> fatal_error_t msg | `Error `Retry -> - debug "ToLVM.resume got `Retry; sleeping"; Lwt_unix.sleep 5. >>= fun () -> resume t @@ -87,7 +84,6 @@ module ToLVM = struct >>= function | `Error _ -> fatal_error_t "reading state of ToLVM" | `Ok `Suspended -> - debug "ToLVM.resume got `Suspended; sleeping"; Lwt_unix.sleep 5. >>= fun () -> wait () @@ -110,7 +106,6 @@ module FromLVM = struct let initial_state = ref `Running in let rec loop () = R.Producer.attach ~queue:(name ^ " FromLVM Producer") ~client:"xenvmd" ~disk () >>= function | `Error `Suspended -> - debug "FromLVM.attach got `Suspended; sleeping"; Lwt_unix.sleep 5. >>= fun () -> initial_state := `Suspended; @@ -125,12 +120,10 @@ module FromLVM = struct let rec push t item = R.Producer.push ~t ~item () >>= function | `Error (`Msg x) -> fatal_error_t (Printf.sprintf "Error pushing to the FromLVM queue: %s" x) | `Error `Retry -> - debug "FromLVM.push got `Retry; sleeping"; Lwt_unix.sleep 5. >>= fun () -> push t item | `Error `Suspended -> - debug "FromLVM.push got `Suspended; sleeping"; Lwt_unix.sleep 5. >>= fun () -> push t item @@ -578,7 +571,6 @@ module FreePool = struct FromLVM.state from_lvm >>= function | `Suspended -> - debug "FromLVM.state got `Suspended; sleeping"; Lwt_unix.sleep 5. >>= fun () -> wait () @@ -761,7 +753,6 @@ let run port sock_path config = VolumeManager.flush_all () >>= fun () -> - debug "sleeping for 5s"; Lwt_unix.sleep 5. >>= fun () -> service_queues () in From 9fa1755099c37206f63a9aafeb436dd88a345ce8 Mon Sep 17 00:00:00 2001 From: David Scott Date: Tue, 16 Jun 2015 09:48:58 +0000 Subject: [PATCH 3/4] local allocator: avoid printing 'sleeping for 5s' or similar This will be less interesting than the metadata tracing will be. Signed-off-by: David Scott --- xenvm-local-allocator/local_allocator.ml | 6 ------ 1 file changed, 6 deletions(-) diff --git a/xenvm-local-allocator/local_allocator.ml b/xenvm-local-allocator/local_allocator.ml index 2511dc0..69d567f 100644 --- a/xenvm-local-allocator/local_allocator.ml +++ b/xenvm-local-allocator/local_allocator.ml @@ -28,7 +28,6 @@ let rec try_forever msg f = >>= function | `Ok x -> return (`Ok x) | `Error `Retry -> - debug "%s: retrying after 5s" msg; Lwt_unix.sleep 5. >>= fun () -> try_forever msg f @@ -85,7 +84,6 @@ module FromLVM = struct >>= function | `Suspended -> return () | `Running -> - debug "FromLVM.suspend got `Running; sleeping"; Lwt_unix.sleep 5. >>= fun () -> wait () in @@ -99,7 +97,6 @@ module FromLVM = struct fatal_error "reading state of FromLVM" (R.Consumer.state t) >>= function | `Suspended -> - debug "FromLVM.resume got `Suspended; sleeping"; Lwt_unix.sleep 5. >>= fun () -> wait () @@ -122,7 +119,6 @@ module ToLVM = struct >>= function | `Ok x -> return x | _ -> - debug "ToLVM.attach got `Error; sleeping"; Lwt_unix.sleep 5. >>= fun () -> attach ~disk () @@ -130,7 +126,6 @@ module ToLVM = struct fatal_error "querying ToLVM state" (R.Producer.state t) let rec push t item = R.Producer.push ~t ~item () >>= function | `Error (`Retry | `Suspended) -> - debug "ToLVM.push got `Error; sleeping"; Lwt_unix.sleep 5. >>= fun () -> push t item @@ -216,7 +211,6 @@ module FreePool = struct >>= fun (pos, ts) -> let open FreeAllocation in ( if ts = [] then begin - debug "No free blocks, sleeping for 5s"; Lwt_unix.sleep 5. end else return () ) >>= fun () -> From f2542e8092fe36f714b1e08a98817d489a80f1b4 Mon Sep 17 00:00:00 2001 From: David Scott Date: Tue, 16 Jun 2015 13:22:54 +0000 Subject: [PATCH 4/4] xenvmd, local allocator: log all the metadata updates on the rings Signed-off-by: David Scott --- idl/log.ml | 24 ++++++++++++++++++++++++ test/common.ml | 6 ------ xenvm-local-allocator/local_allocator.ml | 2 +- xenvmd/xenvmd.ml | 2 +- 4 files changed, 26 insertions(+), 8 deletions(-) diff --git a/idl/log.ml b/idl/log.ml index 1a971bb..5a9d557 100644 --- a/idl/log.ml +++ b/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)) diff --git a/test/common.ml b/test/common.ml index b653708..e1d7d37 100644 --- a/test/common.ml +++ b/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 diff --git a/xenvm-local-allocator/local_allocator.ml b/xenvm-local-allocator/local_allocator.ml index 69d567f..44c8df3 100644 --- a/xenvm-local-allocator/local_allocator.ml +++ b/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 diff --git a/xenvmd/xenvmd.ml b/xenvmd/xenvmd.ml index 87e8116..e79a56e 100644 --- a/xenvmd/xenvmd.ml +++ b/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 ()