From 39acfd5be8a7685da8ff5e1ef1a6ac2d7dd71a30 Mon Sep 17 00:00:00 2001 From: David Scott Date: Wed, 29 Apr 2015 17:14:58 +0100 Subject: [PATCH 1/5] After attaching to a queue, print the current state Signed-off-by: David Scott --- xenvm-local-allocator/local_allocator.ml | 8 ++++++++ xenvmd/xenvmd.ml | 6 ++++++ 2 files changed, 14 insertions(+) diff --git a/xenvm-local-allocator/local_allocator.ml b/xenvm-local-allocator/local_allocator.ml index 6d7c753..9649dd8 100644 --- a/xenvm-local-allocator/local_allocator.ml +++ b/xenvm-local-allocator/local_allocator.ml @@ -71,6 +71,8 @@ module FromLVM = struct module R = Shared_block.Ring.Make(Log)(Vg_IO.Volume)(FreeAllocation) let rec attach ~disk () = fatal_error "attaching to FromLVM queue" (R.Consumer.attach ~disk ()) + let state t = + fatal_error "querying FromLVM state" (R.Consumer.state t) let rec suspend t = try_forever "FromLVM.suspend" (fun () -> R.Consumer.suspend t) >>= fun x -> @@ -173,6 +175,9 @@ module FreePool = struct | `Ok disk -> FromLVM.attach ~disk () >>= fun from_lvm -> + FromLVM.state from_lvm + >>= fun state -> + debug "FromLVM queue is currently %s" (match state with `Running -> "Running" | `Suspended -> "Suspended"); (* Suspend and resume the queue: the producer will resend us all the free blocks on resume. *) @@ -300,6 +305,9 @@ let main config daemon socket journal fromLVM toLVM = | `Ok disk -> ToLVM.attach ~disk () >>= fun tolvm -> + ToLVM.state tolvm + >>= fun state -> + debug "ToLVM queue is currently %s" (match state with `Running -> "Running" | `Suspended -> "Suspended"); let extent_size = metadata.Lvm.Vg.extent_size in (* in sectors *) let extent_size_mib = Int64.(div (mul extent_size (of_int sector_size)) (mul 1024L 1024L)) in diff --git a/xenvmd/xenvmd.ml b/xenvmd/xenvmd.ml index 50622da..73d2c68 100644 --- a/xenvmd/xenvmd.ml +++ b/xenvmd/xenvmd.ml @@ -235,6 +235,9 @@ module VolumeManager = struct | `Ok disk -> ToLVM.attach ~disk () >>= fun to_LVM -> + ToLVM.state to_LVM + >>= fun state -> + debug "ToLVM queue is currently %s" (match state with `Running -> "Running" | `Suspended -> "Suspended"); ToLVM.resume to_LVM >>= fun () -> ( match Vg_IO.find vg fromLVM with @@ -246,6 +249,9 @@ module VolumeManager = struct | `Ok disk -> FromLVM.attach ~disk () >>= fun from_LVM -> + FromLVM.state from_LVM + >>= fun state -> + debug "FromLVM queue is currently %s" (match state with `Running -> "Running" | `Suspended -> "Suspended"); to_LVMs := (name, to_LVM) :: !to_LVMs; from_LVMs := (name, from_LVM) :: !from_LVMs; free_LVs := (name, (freeLVM,freeLVMid)) :: !free_LVs; From 17f63e99d8885982efd76cacfc8da9a62a72d89b Mon Sep 17 00:00:00 2001 From: David Scott Date: Wed, 29 Apr 2015 17:16:43 +0100 Subject: [PATCH 2/5] local allocator: complete the startup sequence before deciding to exit The startup sequence involves suspending and resuming the FromLVM queue. Only after we have performed the handshake with the master should we start checking for a notice to quit. Signed-off-by: David Scott --- xenvm-local-allocator/local_allocator.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/xenvm-local-allocator/local_allocator.ml b/xenvm-local-allocator/local_allocator.ml index 9649dd8..3e4e86d 100644 --- a/xenvm-local-allocator/local_allocator.ml +++ b/xenvm-local-allocator/local_allocator.ml @@ -214,7 +214,7 @@ module FreePool = struct FromLVM.advance from_lvm pos >>= fun () -> loop_forever () in - loop_forever () + return loop_forever end module Op = struct @@ -370,7 +370,9 @@ let main config daemon socket journal fromLVM toLVM = J.start device perform >>|= fun j -> - let (_: unit Lwt.t) = FreePool.start config vg in + FreePool.start config vg + >>= fun forever_fun -> + let (_: unit Lwt.t) = forever_fun () in let (_: unit Lwt.t) = wait_for_shutdown_forever () in (* Called to extend a single device. This function decides what needs to be From 4d0a879d3521a2f59fb438476c8c7adfa641cb02 Mon Sep 17 00:00:00 2001 From: David Scott Date: Wed, 29 Apr 2015 17:18:31 +0100 Subject: [PATCH 3/5] xenvmd: remove a stray 'let rec' A simple 'let' will do. Signed-off-by: David Scott --- xenvmd/xenvmd.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/xenvmd/xenvmd.ml b/xenvmd/xenvmd.ml index 73d2c68..a534583 100644 --- a/xenvmd/xenvmd.ml +++ b/xenvmd/xenvmd.ml @@ -42,7 +42,7 @@ module ToLVM = struct module R = Shared_block.Ring.Make(Log)(Vg_IO.Volume)(ExpandVolume) let create ~disk () = fatal_error "creating ToLVM queue" (R.Producer.create ~disk ()) - let rec attach ~disk () = + let attach ~disk () = fatal_error "attaching to ToLVM queue" (R.Consumer.attach ~disk ()) let state t = fatal_error "querying ToLVM state" (R.Consumer.state t) From d7d3dca895031a297987f0b055c7384af7ced17b Mon Sep 17 00:00:00 2001 From: David Scott Date: Wed, 29 Apr 2015 17:20:08 +0100 Subject: [PATCH 4/5] xenvmd: when attaching to a suspended FromLVM queue, wait This allows the local allocator to start before xenvmd. Signed-off-by: David Scott --- xenvmd/xenvmd.ml | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/xenvmd/xenvmd.ml b/xenvmd/xenvmd.ml index a534583..d49d0f2 100644 --- a/xenvmd/xenvmd.ml +++ b/xenvmd/xenvmd.ml @@ -99,8 +99,13 @@ module FromLVM = struct module R = Shared_block.Ring.Make(Log)(Vg_IO.Volume)(FreeAllocation) let create ~disk () = fatal_error "FromLVM.create" (R.Producer.create ~disk ()) - let attach ~disk () = - fatal_error "FromLVM.attach" (R.Producer.attach ~disk ()) + let rec attach ~disk () = R.Producer.attach ~disk () >>= function + | `Error `Suspended -> + info "FromLVM.attach: `Retry"; + Lwt_unix.sleep 5. + >>= fun () -> + attach ~disk () + | x -> fatal_error "FromLVM.attach" (return x) let state t = fatal_error "FromLVM.state" (R.Producer.state 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) From fecdf1a1f092f22e513e89e14dd1b82d9b94ed7a Mon Sep 17 00:00:00 2001 From: David Scott Date: Wed, 29 Apr 2015 17:25:02 +0100 Subject: [PATCH 5/5] Before sleeping, log the reason why Signed-off-by: David Scott --- xenvm-local-allocator/local_allocator.ml | 5 +++++ xenvmd/xenvmd.ml | 9 ++++++++- 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/xenvm-local-allocator/local_allocator.ml b/xenvm-local-allocator/local_allocator.ml index 3e4e86d..1d35975 100644 --- a/xenvm-local-allocator/local_allocator.ml +++ b/xenvm-local-allocator/local_allocator.ml @@ -83,6 +83,7 @@ module FromLVM = struct >>= function | `Suspended -> return () | `Running -> + debug "FromLVM.suspend got `Running; sleeping"; Lwt_unix.sleep 5. >>= fun () -> wait () in @@ -96,6 +97,7 @@ 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 () @@ -118,6 +120,7 @@ module ToLVM = struct >>= function | `Ok x -> return x | _ -> + debug "ToLVM.attach got `Error; sleeping"; Lwt_unix.sleep 5. >>= fun () -> attach ~disk () @@ -125,6 +128,7 @@ 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 @@ -322,6 +326,7 @@ let main config daemon socket journal fromLVM toLVM = info "The ToLVM queue has been suspended. We will acknowledge and exit"; exit 0 | `Running -> + debug "The ToLVM queue is still running"; Lwt_unix.sleep 5. >>= fun () -> wait_for_shutdown_forever () in diff --git a/xenvmd/xenvmd.ml b/xenvmd/xenvmd.ml index d49d0f2..edea72f 100644 --- a/xenvmd/xenvmd.ml +++ b/xenvmd/xenvmd.ml @@ -52,6 +52,7 @@ 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 @@ -61,6 +62,7 @@ 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 () @@ -71,6 +73,7 @@ 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 @@ -81,6 +84,7 @@ 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 () @@ -101,7 +105,7 @@ module FromLVM = struct fatal_error "FromLVM.create" (R.Producer.create ~disk ()) let rec attach ~disk () = R.Producer.attach ~disk () >>= function | `Error `Suspended -> - info "FromLVM.attach: `Retry"; + debug "FromLVM.attach got `Suspended; sleeping"; Lwt_unix.sleep 5. >>= fun () -> attach ~disk () @@ -110,10 +114,12 @@ 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 @@ -444,6 +450,7 @@ module FreePool = struct FromLVM.state from_lvm >>= function | `Suspended -> + debug "FromLVM.state got `Suspended; sleeping"; Lwt_unix.sleep 5. >>= fun () -> wait ()