diff --git a/ocaml/tests/test_ha_vm_failover.ml b/ocaml/tests/test_ha_vm_failover.ml index 5a775b5d9bd..6b80d8c3df4 100644 --- a/ocaml/tests/test_ha_vm_failover.ml +++ b/ocaml/tests/test_ha_vm_failover.ml @@ -58,6 +58,7 @@ type pool = { master: host; slaves: host list; ha_host_failures_to_tolerate: int64; + cluster: int; } let string_of_vm {memory; name_label} = @@ -68,12 +69,13 @@ let string_of_host {memory_total; name_label; vms} = memory_total name_label (Test_printers.list string_of_vm vms) -let string_of_pool {master; slaves; ha_host_failures_to_tolerate} = +let string_of_pool {master; slaves; ha_host_failures_to_tolerate; cluster} = Printf.sprintf - "{master = %s; slaves = %s; ha_host_failures_to_tolerate = %Ld}" + "{master = %s; slaves = %s; ha_host_failures_to_tolerate = %Ld; cluster = %d}" (string_of_host master) (Test_printers.list string_of_host slaves) ha_host_failures_to_tolerate + cluster let load_vm ~__context ~(vm:vm) ~local_sr ~shared_sr ~local_net ~shared_net = let vm_ref = make_vm ~__context @@ -120,10 +122,9 @@ let load_host ~__context ~host ~local_sr ~shared_sr ~local_net ~shared_net = in host_ref -let setup ~__context {master; slaves; ha_host_failures_to_tolerate} = +let setup ~__context {master; slaves; ha_host_failures_to_tolerate; cluster} = let shared_sr = make_sr ~__context ~shared:true () in let shared_net = make_network ~__context ~bridge:"xenbr0" () in - (* Remove all hosts added by make_test_database *) List.iter (fun host -> Db.Host.destroy ~__context ~self:host) (Db.Host.get_all ~__context); @@ -149,6 +150,13 @@ let setup ~__context {master; slaves; ha_host_failures_to_tolerate} = let master_ref = load_host_and_local_resources master in let (_ : API.ref_host list) = List.map load_host_and_local_resources slaves in + if cluster > 0 then + Test_common.make_cluster_and_cluster_host ~__context () |> ignore; + for i = 0 to (cluster - 1) do + let host = List.nth (Db.Host.get_all ~__context) i in + Test_common.make_cluster_host ~__context ~host () |> ignore; + done; + let pool = Db.Pool.get_all ~__context |> List.hd in Db.Pool.set_master ~__context ~self:pool ~value:master_ref; @@ -181,6 +189,7 @@ module AllProtectedVms = Generic.Make(Generic.EncapsulateState(struct master = {memory_total = gib 256L; name_label = "master"; vms = []}; slaves = []; ha_host_failures_to_tolerate = 0L; + cluster = 0; }, []; (* One unprotected VM. *) @@ -194,6 +203,7 @@ module AllProtectedVms = Generic.Make(Generic.EncapsulateState(struct }; slaves = []; ha_host_failures_to_tolerate = 0L; + cluster = 0; }, []; (* One VM which would be protected if it was running. *) @@ -204,6 +214,7 @@ module AllProtectedVms = Generic.Make(Generic.EncapsulateState(struct }; slaves = []; ha_host_failures_to_tolerate = 0L; + cluster = 0; }, []; (* One protected VM. *) @@ -214,6 +225,7 @@ module AllProtectedVms = Generic.Make(Generic.EncapsulateState(struct }; slaves = []; ha_host_failures_to_tolerate = 0L; + cluster = 0; }, ["vm"]; (* One protected VM and one unprotected VM. *) @@ -231,6 +243,7 @@ module AllProtectedVms = Generic.Make(Generic.EncapsulateState(struct }; slaves = []; ha_host_failures_to_tolerate = 0L; + cluster = 0; }, ["vm1"]; ] @@ -270,6 +283,7 @@ module PlanForNFailures = Generic.Make(Generic.EncapsulateState(struct {memory_total = gib 256L; name_label = "slave"; vms = []} ]; ha_host_failures_to_tolerate = 1L; + cluster = 0; }, Xapi_ha_vm_failover.Plan_exists_for_all_VMs ); @@ -288,6 +302,7 @@ module PlanForNFailures = Generic.Make(Generic.EncapsulateState(struct {memory_total = gib 256L; name_label = "slave"; vms = []} ]; ha_host_failures_to_tolerate = 1L; + cluster = 0; }, Xapi_ha_vm_failover.Plan_exists_for_all_VMs ); @@ -311,6 +326,7 @@ module PlanForNFailures = Generic.Make(Generic.EncapsulateState(struct {memory_total = gib 256L; name_label = "slave"; vms = []} ]; ha_host_failures_to_tolerate = 1L; + cluster = 0; }, Xapi_ha_vm_failover.Plan_exists_for_all_VMs ); @@ -346,6 +362,7 @@ module PlanForNFailures = Generic.Make(Generic.EncapsulateState(struct } ]; ha_host_failures_to_tolerate = 1L; + cluster = 0; }, Xapi_ha_vm_failover.No_plan_exists ); @@ -415,6 +432,7 @@ module AssertNewVMPreservesHAPlan = Generic.Make(Generic.EncapsulateState(struct {memory_total = gib 256L; name_label = "slave"; vms = []} ]; ha_host_failures_to_tolerate = 1L; + cluster = 0; }, {basic_vm with ha_always_run = false; @@ -445,6 +463,7 @@ module AssertNewVMPreservesHAPlan = Generic.Make(Generic.EncapsulateState(struct {memory_total = gib 256L; name_label = "slave"; vms = []} ]; ha_host_failures_to_tolerate = 1L; + cluster = 0; }, {basic_vm with ha_always_run = false; @@ -483,6 +502,7 @@ module AssertNewVMPreservesHAPlan = Generic.Make(Generic.EncapsulateState(struct }; ]; ha_host_failures_to_tolerate = 1L; + cluster = 0; }, {basic_vm with ha_always_run = false; @@ -495,6 +515,72 @@ module AssertNewVMPreservesHAPlan = Generic.Make(Generic.EncapsulateState(struct ] end)) +module ComputeMaxFailures = Generic.Make(Generic.EncapsulateState(struct + module Io = struct + open Xapi_ha_vm_failover + + type input_t = pool + type output_t = int + + let string_of_input_t = string_of_pool + let string_of_output_t = string_of_int + end + + module State = Test_state.XapiDb + + let load_input __context = setup ~__context + + let extract_output __context pool = + let max_hosts = Xapi_ha_vm_failover.compute_max_host_failures_to_tolerate ~__context () in + (* Struct requires input_t but not used here *) + pool |> ignore; + Int64.to_int max_hosts + + let tests = [ + (* Three host pool with no VMs. *) + ( + { + master = {memory_total = gib 256L; name_label = "master"; vms = []}; + slaves = [ + {memory_total = gib 256L; name_label = "slave1"; vms = []}; + {memory_total = gib 256L; name_label = "slave2"; vms = []} + ]; + (* Placeholder value that is overridden when we call the compute function *) + ha_host_failures_to_tolerate = 3L; + cluster = 3; + }, + (* Assert that compute ha host failures to tolerate returns 1 *) + 1 + ); + (* Two hosts pool with no VMs *) + ( + { + master = {memory_total = gib 256L; name_label = "master"; vms = []}; + slaves = [ + {memory_total = gib 256L; name_label = "slave1"; vms = []} + ]; + ha_host_failures_to_tolerate = 2L; + cluster = 2; + }, + (* Assert that compute ha host failures to tolerate returns 0 *) + 0 + ); + (* Two host pool with one down *) + ( + { + master = {memory_total = gib 256L; name_label = "master"; vms = []}; + slaves = [ + {memory_total = gib 256L; name_label = "slave1"; vms = []} + ]; + ha_host_failures_to_tolerate = 2L; + cluster = 1; + }, + (* Assert that compute ha host failures to tolerate returns 1 *) + 1 + ); + ] + end)) + let test = "test_ha_vm_failover" >::: [ @@ -502,4 +588,5 @@ let test = "test_plan_for_n_failures" >::: PlanForNFailures.tests; "test_assert_new_vm_preserves_ha_plan" >::: AssertNewVMPreservesHAPlan.tests; + "test_corosync_max_host_failures" >::: ComputeMaxFailures.tests; ] diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index 3de165a8ca4..c986ea23cd0 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -591,14 +591,16 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct Local.Pool.ha_failover_plan_exists ~__context ~n let ha_compute_max_host_failures_to_tolerate ~__context = - info "Pool.ha_compute_max_host_failures_to_tolerate: pool = '%s'" (current_pool_uuid ~__context); - Local.Pool.ha_compute_max_host_failures_to_tolerate ~__context + Xapi_clustering.with_clustering_lock_if_cluster_exists ~__context (fun () -> + info "Pool.ha_compute_max_host_failures_to_tolerate: pool = '%s'" (current_pool_uuid ~__context); + Local.Pool.ha_compute_max_host_failures_to_tolerate ~__context) let ha_compute_hypothetical_max_host_failures_to_tolerate ~__context ~configuration = - info "Pool.ha_compute_hypothetical_max_host_failures_to_tolerate: pool = '%s'; configuration = [ %s ]" - (current_pool_uuid ~__context) - (String.concat "; " (List.map (fun (vm, p) -> Ref.string_of vm ^ " " ^ p) configuration)); - Local.Pool.ha_compute_hypothetical_max_host_failures_to_tolerate ~__context ~configuration + Xapi_clustering.with_clustering_lock_if_cluster_exists ~__context (fun () -> + info "Pool.ha_compute_hypothetical_max_host_failures_to_tolerate: pool = '%s'; configuration = [ %s ]" + (current_pool_uuid ~__context) + (String.concat "; " (List.map (fun (vm, p) -> Ref.string_of vm ^ " " ^ p) configuration)); + Local.Pool.ha_compute_hypothetical_max_host_failures_to_tolerate ~__context ~configuration) let ha_compute_vm_failover_plan ~__context ~failed_hosts ~failed_vms = info "Pool.ha_compute_vm_failover_plan: pool = '%s'; failed_hosts = [ %s ]; failed_vms = [ %s ]" @@ -608,8 +610,9 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct Local.Pool.ha_compute_vm_failover_plan ~__context ~failed_hosts ~failed_vms let set_ha_host_failures_to_tolerate ~__context ~self ~value = - info "Pool.set_ha_host_failures_to_tolerate: pool = '%s'; value = %Ld" (pool_uuid ~__context self) value; - Local.Pool.set_ha_host_failures_to_tolerate ~__context ~self ~value + Xapi_clustering.with_clustering_lock_if_cluster_exists ~__context (fun () -> + info "Pool.set_ha_host_failures_to_tolerate: pool = '%s'; value = %Ld" (pool_uuid ~__context self) value; + Local.Pool.set_ha_host_failures_to_tolerate ~__context ~self ~value) let ha_schedule_plan_recomputation ~__context = info "Pool.ha_schedule_plan_recomputation: pool = '%s'" (current_pool_uuid ~__context); diff --git a/ocaml/xapi/xapi_clustering.ml b/ocaml/xapi/xapi_clustering.ml index f751a8f4fbb..dee81de5b93 100644 --- a/ocaml/xapi/xapi_clustering.ml +++ b/ocaml/xapi/xapi_clustering.ml @@ -102,6 +102,11 @@ let with_clustering_lock_if_needed ~__context ~sr_sm_type f = | [] -> f () | _required_cluster_stacks -> with_clustering_lock f +let with_clustering_lock_if_cluster_exists ~__context f = + match Db.Cluster.get_all ~__context with + | [] -> f () + | _ -> with_clustering_lock f + let find_cluster_host ~__context ~host = match Db.Cluster_host.get_refs_where ~__context ~expr:(Db_filter_types.(Eq (Field "host", Literal (Ref.string_of host)))) with @@ -203,3 +208,10 @@ let is_clustering_disabled_on_host ~__context host = match find_cluster_host ~__context ~host with | None -> true (* there is no Cluster_host, therefore it is not enabled, therefore it is disabled *) | Some cluster_host -> not (Db.Cluster_host.get_enabled ~__context ~self:cluster_host) + +let compute_corosync_max_host_failures ~__context = + let all_hosts = Db.Host.get_all ~__context in + let nhosts = List.length (all_hosts) in + let disabled_hosts = List.length (List.filter (fun host -> is_clustering_disabled_on_host ~__context host = true ) all_hosts) in + let corosync_ha_max_hosts = ((nhosts - disabled_hosts - 1) / 2) + disabled_hosts in + corosync_ha_max_hosts diff --git a/ocaml/xapi/xapi_ha_vm_failover.ml b/ocaml/xapi/xapi_ha_vm_failover.ml index b2f1badbb0a..e6721b54fd5 100644 --- a/ocaml/xapi/xapi_ha_vm_failover.ml +++ b/ocaml/xapi/xapi_ha_vm_failover.ml @@ -318,7 +318,12 @@ let compute_max_host_failures_to_tolerate ~__context ?live_set ?protected_vms () let protected_vms = match protected_vms with | None -> all_protected_vms ~__context | Some vms -> vms in - let nhosts = List.length (Db.Host.get_all ~__context) in + let total_hosts = List.length (Db.Host.get_all ~__context) in + (* For corosync HA less than half of the pool can fail whilst maintaining quorum *) + let corosync_ha_max_hosts = Xapi_clustering.compute_corosync_max_host_failures ~__context in + let nhosts = match Db.Cluster.get_all ~__context with + | [] -> total_hosts + | _ -> corosync_ha_max_hosts in (* We assume that if not(plan_exists(n)) then \forall.x>n not(plan_exists(n)) although even if we screw this up it's not a disaster because all we need is a safe approximation (so ultimately "0" will do but we'd prefer higher) *) @@ -327,37 +332,38 @@ let compute_max_host_failures_to_tolerate ~__context ?live_set ?protected_vms () (* Make sure the pool is marked as overcommitted and the appropriate alert is generated. Return true if something changed, false otherwise *) let mark_pool_as_overcommitted ~__context ~live_set = - let pool = Helpers.get_pool ~__context in - - let overcommitted = Db.Pool.get_ha_overcommitted ~__context ~self:pool in - let planned_for = Db.Pool.get_ha_plan_exists_for ~__context ~self:pool in - let to_tolerate = Db.Pool.get_ha_host_failures_to_tolerate ~__context ~self:pool in - - let max_failures = compute_max_host_failures_to_tolerate ~__context ~live_set () in - if planned_for <> max_failures then begin - Db.Pool.set_ha_plan_exists_for ~__context ~self:pool ~value:(min to_tolerate max_failures); - if max_failures < planned_for - then Xapi_alert.add ~msg:Api_messages.ha_pool_drop_in_plan_exists_for ~cls:`Pool ~obj_uuid:(Db.Pool.get_uuid ~__context ~self:pool) ~body:(Int64.to_string max_failures); - end; - - if not overcommitted then begin - Db.Pool.set_ha_overcommitted ~__context ~self:pool ~value:true; - - (* On the transition generate a message *) - let obj_uuid = Db.Pool.get_uuid ~__context ~self:pool in - let pool_name_label = Db.Pool.get_name_label ~__context ~self:pool in - (* Note -- it's OK to look up stuff in the database when generating the alert text, because this code runs on the master; therefore there is no - danger of blocking for db.* calls to return *) - let (name, priority) = Api_messages.ha_pool_overcommitted in - let (_: 'a Ref.t) = Xapi_message.create ~__context ~name ~priority ~cls:`Pool ~obj_uuid - ~body:(Printf.sprintf "The failover tolerance for pool '%s' has dropped and the initially specified number of host failures to tolerate can no longer be guaranteed" - pool_name_label) in - (); - (* Call a hook to allow someone the opportunity to bring more capacity online *) - Xapi_hooks.pool_ha_overcommitted_hook ~__context - end; - - planned_for <> max_failures || (not overcommitted) + Xapi_clustering.with_clustering_lock_if_cluster_exists ~__context (fun () -> + let pool = Helpers.get_pool ~__context in + + let overcommitted = Db.Pool.get_ha_overcommitted ~__context ~self:pool in + let planned_for = Db.Pool.get_ha_plan_exists_for ~__context ~self:pool in + let to_tolerate = Db.Pool.get_ha_host_failures_to_tolerate ~__context ~self:pool in + + let max_failures = compute_max_host_failures_to_tolerate ~__context ~live_set () in + if planned_for <> max_failures then begin + Db.Pool.set_ha_plan_exists_for ~__context ~self:pool ~value:(min to_tolerate max_failures); + if max_failures < planned_for + then Xapi_alert.add ~msg:Api_messages.ha_pool_drop_in_plan_exists_for ~cls:`Pool ~obj_uuid:(Db.Pool.get_uuid ~__context ~self:pool) ~body:(Int64.to_string max_failures); + end; + + if not overcommitted then begin + Db.Pool.set_ha_overcommitted ~__context ~self:pool ~value:true; + + (* On the transition generate a message *) + let obj_uuid = Db.Pool.get_uuid ~__context ~self:pool in + let pool_name_label = Db.Pool.get_name_label ~__context ~self:pool in + (* Note -- it's OK to look up stuff in the database when generating the alert text, because this code runs on the master; therefore there is no + danger of blocking for db.* calls to return *) + let (name, priority) = Api_messages.ha_pool_overcommitted in + let (_: 'a Ref.t) = Xapi_message.create ~__context ~name ~priority ~cls:`Pool ~obj_uuid + ~body:(Printf.sprintf "The failover tolerance for pool '%s' has dropped and the initially specified number of host failures to tolerate can no longer be guaranteed" + pool_name_label) in + (); + (* Call a hook to allow someone the opportunity to bring more capacity online *) + Xapi_hooks.pool_ha_overcommitted_hook ~__context + end; + + planned_for <> max_failures || (not overcommitted)) (* Update the pool's HA fields *) let update_pool_status ~__context ?live_set () =