From 932e6892009b9a79d03ae5f20e165bf6c91a07ca Mon Sep 17 00:00:00 2001 From: Akanksha Mathur Date: Mon, 11 Jun 2018 12:22:10 +0100 Subject: [PATCH 1/5] Remove obsolete clustering quicktest Quicktest uses outdated framework and has since been converted to a unit test in test_clustering (test_assert_no_clustering_on_pif) Signed-off-by: Akanksha Mathur --- ocaml/quicktest/quicktest_cluster.ml | 85 ---------------------------- 1 file changed, 85 deletions(-) delete mode 100644 ocaml/quicktest/quicktest_cluster.ml diff --git a/ocaml/quicktest/quicktest_cluster.ml b/ocaml/quicktest/quicktest_cluster.ml deleted file mode 100644 index d105c74f194..00000000000 --- a/ocaml/quicktest/quicktest_cluster.ml +++ /dev/null @@ -1,85 +0,0 @@ - -module Q = Quicktest_common -module C = Client.Client - -let is_empty = function | [] -> true | _ -> false -let rpc = !Q.rpc - -(* [Q.failed test.Q.name string_of_failure] removes [test] from a test Hashtbl - * and is therefore only called once, in the try-with statement. - * This exception is raised within the try-with body to trigger - * [Q.failed test string_of_failure] *) -exception Abort_test of string - -(** --- Helpers for IP reconfiguration tests --- *) - -let reconfigure_ipv4 ~session_id ~self ~dNS = - let netmask = C.PIF.get_netmask ~session_id ~rpc ~self in - let iP = C.PIF.get_IP ~session_id ~rpc ~self in - let gateway = C.PIF.get_gateway ~session_id ~rpc ~self in - let mode = C.PIF.get_ip_configuration_mode ~session_id ~rpc ~self in - C.PIF.reconfigure_ip ~session_id ~rpc ~self ~iP ~dNS ~gateway ~netmask ~mode - -let reconfigure_ipv6 ~session_id ~self ~dNS = - - (* confirm valid IPv6 strings exist *) - let iPv6_lst = (C.PIF.get_IPv6 ~session_id ~rpc ~self) |> List.filter ((<>) "") in - if is_empty iPv6_lst - then raise (Abort_test "No valid IPv6 strings exist."); - - let gateway = C.PIF.get_ipv6_gateway ~session_id ~rpc ~self in - let mode = C.PIF.get_ipv6_configuration_mode ~session_id ~rpc ~self in - let iPv6 = List.hd iPv6_lst in - C.PIF.reconfigure_ipv6 ~session_id ~rpc ~self ~iPv6 ~dNS ~gateway ~mode - -(** --- Test skeleton, receives environment params before running --- *) -let test_reconfigure_ip ~ipv6 ~session_id ~(self : API.ref_PIF) = - let ip_string = if ipv6 then "IPv6" else "IPv4" in - let test = - Q.make_test (Printf.sprintf "Testing reconfiguring %s with clustering." ip_string) 4 - in - try - Q.start test; - - let dNS = C.PIF.get_DNS ~session_id ~rpc ~self in - if ipv6 - then reconfigure_ipv6 ~session_id ~self ~dNS - else reconfigure_ipv4 ~session_id ~self ~dNS; - - Q.failed test "PIF.reconfigure_ip should raise CLUSTERING_ENABLED" - with - | Api_errors.(Server_error(code,_)) when code=Api_errors.clustering_enabled - -> Q.debug test (Printf.sprintf "%s raised as expected." Api_errors.clustering_enabled); - Q.success test - | Api_errors.(Server_error(_,_)) -> () (* Don't fail on other API errors, only test clustering *) - | Abort_test s -> Q.failed test s - | e -> Q.failed test (ExnHelper.string_of_exn e) - -(** --- Check environment before calling test --- *) -let test session_id = - let test_all_pifs = Q.make_test "Testing IP reconfiguration with and without clustering." 2 in - try - print_newline (); - Q.start test_all_pifs; - print_newline (); - - let enabled_cluster_hosts = - List.filter - (fun self -> C.Cluster_host.get_enabled ~session_id ~rpc ~self) - (C.Cluster_host.get_all ~session_id ~rpc) - in - if is_empty enabled_cluster_hosts - then Q.debug test_all_pifs "No PIFS with clustering enabled, skipping tests." - else begin - enabled_cluster_hosts - |> List.map - (fun self -> C.Cluster_host.get_PIF ~session_id ~rpc ~self) - |> List.iter - (fun self -> - test_reconfigure_ip ~ipv6:false ~session_id ~self - (* IPv6 clusters not yet supported, can run this line once they are: - test_reconfigure_ip ~ipv6:true ~session_id ~self *) - ); - Q.success test_all_pifs - end - with e -> Q.failed test_all_pifs (ExnHelper.string_of_exn e) From 2229b79aac128c33180b1a50ae22a796cc90ea9b Mon Sep 17 00:00:00 2001 From: Akanksha Mathur Date: Mon, 11 Jun 2018 09:42:35 +0000 Subject: [PATCH 2/5] CP-28477: Cluster code cleanup Signed-off-by: Akanksha Mathur --- ocaml/idl/datamodel_errors.ml | 2 +- ocaml/xapi/xapi_cluster.ml | 13 +++++-------- ocaml/xapi/xapi_cluster_host.ml | 2 +- 3 files changed, 7 insertions(+), 10 deletions(-) diff --git a/ocaml/idl/datamodel_errors.ml b/ocaml/idl/datamodel_errors.ml index d1a0e68d346..325d4909bca 100644 --- a/ocaml/idl/datamodel_errors.ml +++ b/ocaml/idl/datamodel_errors.ml @@ -1129,7 +1129,7 @@ let _ = error Api_errors.clustering_disabled ["cluster_host"] ~doc:"An operation was attempted while clustering was disabled on the cluster_host." (); error Api_errors.cluster_does_not_have_one_node ["number_of_nodes"] - ~doc:"The cluster does not have only one node." (); + ~doc:"An operation failed as it expected the cluster to have only one node but found multiple cluster_hosts." (); error Api_errors.no_compatible_cluster_host ["host"] ~doc:"The host does not have a Cluster_host with a compatible cluster stack." (); error Api_errors.cluster_force_destroy_failed ["cluster"] diff --git a/ocaml/xapi/xapi_cluster.ml b/ocaml/xapi/xapi_cluster.ml index ecd6d56e9f1..b2d5e91fdd6 100644 --- a/ocaml/xapi/xapi_cluster.ml +++ b/ocaml/xapi/xapi_cluster.ml @@ -93,8 +93,7 @@ let destroy ~__context ~self = set_ha_cluster_stack ~__context; Xapi_clustering.Daemon.disable ~__context -let get_network ~__context ~self = - get_network_internal ~__context ~self +let get_network = get_network_internal (* helper function; concurrency checks are done in implementation of Cluster.create and Cluster_host.create *) let pool_create ~__context ~network ~cluster_stack ~token_timeout ~token_timeout_coefficient = @@ -110,8 +109,8 @@ let pool_create ~__context ~network ~cluster_stack ~token_timeout ~token_timeout List.iter (fun host -> (* Cluster.create already created cluster_host on master, so we only need to iterate through slaves *) Helpers.call_api_functions ~__context (fun rpc session_id -> - let pifref,_ = pif_of_host ~__context network host in - let cluster_host_ref = Client.Client.Cluster_host.create ~rpc ~session_id ~cluster ~host ~pif:pifref in + let pif,_ = pif_of_host ~__context network host in + let cluster_host_ref = Client.Client.Cluster_host.create ~rpc ~session_id ~cluster ~host ~pif in D.debug "Created Cluster_host: %s" (Ref.string_of cluster_host_ref); )) slave_hosts; @@ -144,8 +143,7 @@ let pool_force_destroy ~__context ~self = Helpers.call_api_functions ~__context (fun rpc session_id -> Client.Client.Cluster_host.destroy ~rpc ~session_id ~self:cluster_host) ) - ) - slave_cluster_hosts; + ) slave_cluster_hosts; (* We expect destroy to have failed for some, we'll try to force destroy those *) (* Note we include the master here, we should attempt to force destroy it *) let all_remaining_cluster_hosts = @@ -164,8 +162,7 @@ let pool_force_destroy ~__context ~self = debug "Ignoring exception while trying to force destroy cluster host %s: %s" uuid (ExnHelper.string_of_exn e); e :: exns_so_far ) - ) - [] all_remaining_cluster_hosts + ) [] all_remaining_cluster_hosts in begin match exns with diff --git a/ocaml/xapi/xapi_cluster_host.ml b/ocaml/xapi/xapi_cluster_host.ml index 024b3c46b58..afdb60eda63 100644 --- a/ocaml/xapi/xapi_cluster_host.ml +++ b/ocaml/xapi/xapi_cluster_host.ml @@ -263,7 +263,7 @@ let create_as_necessary ~__context ~host = match sync_required ~__context ~host with | Some cluster -> (* assume pool autojoin set *) let network = get_network_internal ~__context ~self:cluster in - let (pIF,pifrec) = Xapi_clustering.pif_of_host ~__context network host in + let pIF,_ = Xapi_clustering.pif_of_host ~__context network host in create_internal ~__context ~cluster ~host ~pIF |> ignore | None -> () From f8415af75aed256078f22d3ddcad95c493dfa4b2 Mon Sep 17 00:00:00 2001 From: Akanksha Mathur Date: Mon, 11 Jun 2018 10:36:38 +0000 Subject: [PATCH 3/5] CP-28477: Cluster_host.force_destroy ignores exn Signed-off-by: Akanksha Mathur --- ocaml/xapi/xapi_cluster_host.ml | 23 ++++++++++++++++------- 1 file changed, 16 insertions(+), 7 deletions(-) diff --git a/ocaml/xapi/xapi_cluster_host.ml b/ocaml/xapi/xapi_cluster_host.ml index afdb60eda63..f22031ec3e6 100644 --- a/ocaml/xapi/xapi_cluster_host.ml +++ b/ocaml/xapi/xapi_cluster_host.ml @@ -134,24 +134,33 @@ let create ~__context ~cluster ~host ~pif = resync_host ~__context ~host; cluster_host -let destroy_op ~__context ~self meth = +let destroy_op ~__context ~self ~force = with_clustering_lock __LOC__ (fun () -> let dbg = Context.string_of_task __context in let host = Db.Cluster_host.get_host ~__context ~self in assert_operation_host_target_is_localhost ~__context ~host; assert_cluster_host_has_no_attached_sr_which_requires_cluster_stack ~__context ~self; - let result = Cluster_client.LocalClient.destroy (rpc ~__context) dbg in + let local_fn, fn_str = + if force + then Cluster_client.LocalClient.destroy, "force_destroy" + else Cluster_client.LocalClient.leave, "destroy" + in + let result = local_fn (rpc ~__context) dbg in match result with | Result.Ok () -> Db.Cluster_host.destroy ~__context ~self; - debug "Cluster_host.%s was successful" meth; + debug "Cluster_host.%s was successful" fn_str; Xapi_clustering.Daemon.disable ~__context | Result.Error error -> - warn "Error occurred during Cluster_host.%s" meth; - handle_error error) + warn "Error occurred during Cluster_host.%s" fn_str; + if force then begin + let ref_str = Ref.string_of self in + Db.Cluster_host.destroy ~__context ~self; + debug "Cluster_host %s force destroyed." ref_str + end else handle_error error) let force_destroy ~__context ~self = - destroy_op ~__context ~self "force_destroy" + destroy_op ~__context ~self ~force:true let destroy ~__context ~self = assert_cluster_host_enabled ~__context ~self ~expected:true; @@ -161,7 +170,7 @@ let destroy ~__context ~self = raise Api_errors.(Server_error (cluster_host_is_last, [Ref.string_of self])) | _ -> () in - destroy_op ~__context ~self "destroy" + destroy_op ~__context ~self ~force:false let ip_of_str str = Cluster_interface.IPv4 str From 7867d9182861eea200b66ef4ae92d99ad056dc20 Mon Sep 17 00:00:00 2001 From: Akanksha Mathur Date: Thu, 14 Jun 2018 18:03:34 +0000 Subject: [PATCH 4/5] CP-28477: Cluster_host.forget deletes cluster_host if successful Signed-off-by: Akanksha Mathur --- ocaml/xapi/message_forwarding.ml | 1 + ocaml/xapi/xapi_cluster_host.ml | 5 +++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index 61534275e36..e82b4667440 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -4395,6 +4395,7 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct let forget ~__context ~self = info "Cluster_host.forget cluster_host:%s" (Ref.string_of self); + Db.Cluster_host.set_joined ~__context ~self ~value:false; let cluster = Db.Cluster_host.get_cluster ~__context ~self in let local_fn = Local.Cluster_host.forget ~self in (* We need to ask another host that has a cluster host to mark it as dead. diff --git a/ocaml/xapi/xapi_cluster_host.ml b/ocaml/xapi/xapi_cluster_host.ml index f22031ec3e6..a869e7f2a82 100644 --- a/ocaml/xapi/xapi_cluster_host.ml +++ b/ocaml/xapi/xapi_cluster_host.ml @@ -192,6 +192,7 @@ let forget ~__context ~self = Db.Cluster.set_pending_forget ~__context ~self:cluster ~value:[]; (* must not disable the daemon here, because we declared another unreachable node dead, * not the current one *) + Db.Cluster_host.destroy ~__context ~self; debug "Cluster_host.forget was successful" | Result.Error error -> warn "Error encountered when declaring dead cluster_host %s (did you declare all dead hosts yet?)" (Ref.string_of self); @@ -246,8 +247,8 @@ let disable_clustering ~__context = match Xapi_clustering.find_cluster_host ~__context ~host with | None -> info "No cluster host found" | Some self -> - info "Disabling cluster_host %s" (Ref.string_of self); - disable ~__context ~self + info "Disabling cluster_host %s" (Ref.string_of self); + disable ~__context ~self let sync_required ~__context ~host = let clusters = Db.Cluster.get_all_records ~__context in From 259c4014226ee33ea71718ba1422e2818221455f Mon Sep 17 00:00:00 2001 From: Akanksha Mathur Date: Mon, 11 Jun 2018 11:15:46 +0000 Subject: [PATCH 5/5] CP-28477, CP-26179: Forward Cluster.destroy, pool_destroy works without master cluster_host CP-28477: Forward Cluster.destroy to cluster member (maybe localhost) CP-26179: make pool_destroy work if master isn't in cluster CP-28477: Prevent new hosts joining cluster during Cluster.pool*_destroy - Factor out common code between pool_destroy and pool_force_destroy into helper pool_destroy_common CP-28477: Cluster.pool_force_destroy succeeds without cluster_host on master CP-28744: Make Cluster.pool_force_destroy more robust CP-28477: Update clustering tests using Cluster.destroy --- ocaml/tests/test_clustering.ml | 4 +- ocaml/xapi/message_forwarding.ml | 16 +++- ocaml/xapi/xapi_cluster.ml | 134 ++++++++++++++----------------- ocaml/xapi/xapi_cluster.mli | 7 +- 4 files changed, 81 insertions(+), 80 deletions(-) diff --git a/ocaml/tests/test_clustering.ml b/ocaml/tests/test_clustering.ml index 28214e119f5..599d6ea8361 100644 --- a/ocaml/tests/test_clustering.ml +++ b/ocaml/tests/test_clustering.ml @@ -621,9 +621,7 @@ let test_pool_ha_cluster_stacks_with_ha_with_clustering () = assert_cluster_stack_is default_smapiv3 ~__context; Db.Pool.set_ha_enabled ~__context ~self:pool ~value:true; - Xapi_cluster_host.force_destroy ~__context ~self:cluster_host2; - assert_cluster_stack_is default_smapiv3 ~__context; - Xapi_cluster.destroy ~__context ~self:cluster2; + Xapi_cluster.pool_destroy ~__context ~self:cluster2; assert_cluster_stack_is default ~__context diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index e82b4667440..cd458901504 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -4297,6 +4297,17 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct end module Cluster = struct + + let forward_cluster_op ~local_fn ~__context op = + let localhost = Helpers.get_localhost ~__context in + let is_local_cluster_host self = Db.Cluster_host.get_host ~__context ~self = localhost in + let host = match Db.Cluster_host.get_all ~__context with + | [] -> Helpers.get_master ~__context + | lst when List.exists is_local_cluster_host lst -> localhost + | self :: _ -> Db.Cluster_host.get_host ~__context ~self + in + do_op_on ~local_fn ~__context ~host op + let create ~__context ~pIF ~cluster_stack ~pool_auto_join ~token_timeout ~token_timeout_coefficient = info "Cluster.create"; let pool = Helpers.get_pool ~__context in (* assumes 1 pool in DB *) @@ -4311,7 +4322,10 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct info "Cluster.destroy cluster: %s" (Ref.string_of self); Xapi_cluster_helpers.with_cluster_operation ~__context ~self ~doc:"Cluster.destroy" ~op:`destroy (fun () -> - Local.Cluster.destroy ~__context ~self) + let local_fn = Local.Cluster.destroy ~self in + forward_cluster_op ~__context ~local_fn + (fun rpc session_id -> Client.Cluster.destroy session_id rpc self) + ) let get_network ~__context ~self = info "Cluster.get_network"; diff --git a/ocaml/xapi/xapi_cluster.ml b/ocaml/xapi/xapi_cluster.ml index b2d5e91fdd6..155b3ef28fc 100644 --- a/ocaml/xapi/xapi_cluster.ml +++ b/ocaml/xapi/xapi_cluster.ml @@ -78,7 +78,9 @@ let create ~__context ~pIF ~cluster_stack ~pool_auto_join ~token_timeout ~token_ let destroy ~__context ~self = let cluster_hosts = Db.Cluster.get_cluster_hosts ~__context ~self in let cluster_host = match cluster_hosts with - | [] -> None + | [] -> + info "No cluster_hosts found. Proceeding with cluster destruction."; + None | [ cluster_host ] -> Some (cluster_host) | _ -> let n = List.length cluster_hosts in @@ -93,9 +95,12 @@ let destroy ~__context ~self = set_ha_cluster_stack ~__context; Xapi_clustering.Daemon.disable ~__context +(* Get pool master's cluster_host, return network of PIF *) let get_network = get_network_internal -(* helper function; concurrency checks are done in implementation of Cluster.create and Cluster_host.create *) +(** Cluster.pool* functions are convenience wrappers for iterating low-level APIs over a pool. + Concurrency checks are done in the implementation of these calls *) + let pool_create ~__context ~network ~cluster_stack ~token_timeout ~token_timeout_coefficient = validate_params ~token_timeout ~token_timeout_coefficient; let master = Helpers.get_master ~__context in @@ -107,7 +112,7 @@ let pool_create ~__context ~network ~cluster_stack ~token_timeout ~token_timeout in List.iter (fun host -> - (* Cluster.create already created cluster_host on master, so we only need to iterate through slaves *) + (* Cluster.create already created cluster_host on master, so we only iterate through slaves *) Helpers.call_api_functions ~__context (fun rpc session_id -> let pif,_ = pif_of_host ~__context network host in let cluster_host_ref = Client.Client.Cluster_host.create ~rpc ~session_id ~cluster ~host ~pif in @@ -116,92 +121,73 @@ let pool_create ~__context ~network ~cluster_stack ~token_timeout ~token_timeout cluster -(* Helper function; if opn is None return all, else return those not equal to it *) -let filter_on_option opn xs = - match opn with - | None -> xs - | Some x -> List.filter ((<>) x) xs +let foreach_cluster_host ~__context ~self ~(fn : rpc:(Rpc.call -> Rpc.response) -> + session_id:API.ref_session -> self:API.ref_Cluster_host -> unit) ~log = + let wrapper = if log then log_and_ignore_exn else (fun f -> f ()) in + List.iter (fun self -> + Helpers.call_api_functions ~__context + (fun rpc session_id -> wrapper (fun () -> fn rpc session_id self))) -(* Helper function; concurrency checks are done in implementation of Cluster.destroy and Cluster_host.destroy *) -let pool_force_destroy ~__context ~self = - (* For now we assume we have only one pool, and that the cluster is the same as the pool. - This means that the pool master must be a member of this cluster. *) - let master = Helpers.get_master ~__context in - let master_cluster_host = - Xapi_clustering.find_cluster_host ~__context ~host:master - in +let pool_destroy_common ~__context ~self ~force = + (* Prevent new hosts from joining if destroy fails *) + Db.Cluster.set_pool_auto_join ~__context ~self ~value:false; let slave_cluster_hosts = - Db.Cluster.get_cluster_hosts ~__context ~self |> filter_on_option master_cluster_host + let all_hosts = Db.Cluster.get_cluster_hosts ~__context ~self in + let master = Helpers.get_master ~__context in + match Xapi_clustering.find_cluster_host ~__context ~host:master with + | None -> all_hosts + | Some master_ch -> + List.filter ((<>) master_ch) all_hosts in - debug "Destroying cluster_hosts in pool"; - (* First try to destroy each cluster_host - if we can do so safely then do *) - List.iter - (fun cluster_host -> - (* We need to run this code on the slave *) - (* We ignore failures here, we'll try a force_destroy after *) - log_and_ignore_exn (fun () -> - Helpers.call_api_functions ~__context (fun rpc session_id -> - Client.Client.Cluster_host.destroy ~rpc ~session_id ~self:cluster_host) - ) - ) slave_cluster_hosts; - (* We expect destroy to have failed for some, we'll try to force destroy those *) + foreach_cluster_host ~__context ~self ~log:force + ~fn:Client.Client.Cluster_host.destroy + slave_cluster_hosts + +let pool_force_destroy ~__context ~self = + (* Set pool_autojoin:false and try to destroy slave cluster_hosts *) + pool_destroy_common ~__context ~self ~force:true; + (* Note we include the master here, we should attempt to force destroy it *) - let all_remaining_cluster_hosts = - Db.Cluster.get_cluster_hosts ~__context ~self - in (* Now try to force_destroy, keep track of any errors here *) - let exns = List.fold_left - (fun exns_so_far cluster_host -> - Helpers.call_api_functions ~__context (fun rpc session_id -> - try - Client.Client.Cluster_host.force_destroy ~rpc ~session_id ~self:cluster_host; - exns_so_far - with e -> - Backtrace.is_important e; - let uuid = Client.Client.Cluster_host.get_uuid ~rpc ~session_id ~self:cluster_host in - debug "Ignoring exception while trying to force destroy cluster host %s: %s" uuid (ExnHelper.string_of_exn e); - e :: exns_so_far - ) - ) [] all_remaining_cluster_hosts - in - - begin match exns with - | [] -> D.debug "Successfully destroyed all cluster_hosts in pool, now destroying cluster %s" (Ref.string_of self) - | e :: _ -> raise Api_errors.(Server_error (cluster_force_destroy_failed, [Ref.string_of self])) - end; - + debug "Ignoring exceptions while trying to force destroy cluster hosts."; + foreach_cluster_host ~__context ~self ~log:true + ~fn:Client.Client.Cluster_host.force_destroy + (Db.Cluster.get_cluster_hosts ~__context ~self); + + info "Forgetting any cluster_hosts that couldn't be destroyed."; + foreach_cluster_host ~__context ~self ~log:true + ~fn:Client.Client.Cluster_host.forget + (Db.Cluster_host.get_all ~__context); + + let unforgotten_cluster_hosts = List.filter + (fun self -> not (Db.Cluster_host.get_joined ~__context ~self)) + (Db.Cluster_host.get_all ~__context) + in + info "If forget failed on any remaining cluster_hosts, we now delete them competely"; + foreach_cluster_host ~__context ~self ~log:false + ~fn:(fun ~rpc ~session_id ~self -> Db.Cluster_host.destroy ~__context ~self) + unforgotten_cluster_hosts; + + match Db.Cluster_host.get_all ~__context with + | [] -> + D.debug "Successfully destroyed all cluster_hosts in pool, now destroying cluster %s" + (Ref.string_of self); Helpers.call_api_functions ~__context (fun rpc session_id -> Client.Client.Cluster.destroy ~rpc ~session_id ~self); - debug "Cluster_host.force_destroy was successful" + debug "Cluster.pool_force_destroy was successful"; + | _ -> raise Api_errors.(Server_error (cluster_force_destroy_failed, [Ref.string_of self])) -(* Helper function; concurrency checks are done in implementation of Cluster.destroy and Cluster_host.destroy *) let pool_destroy ~__context ~self = - (* For now we assume we have only one pool, and that the cluster is the same as the pool. - This means that the pool master must be a member of this cluster. *) - let master = Helpers.get_master ~__context in - let master_cluster_host = - Xapi_clustering.find_cluster_host ~__context ~host:master - |> Xapi_stdext_monadic.Opt.unbox - in - let slave_cluster_hosts = - Db.Cluster.get_cluster_hosts ~__context ~self |> List.filter ((<>) master_cluster_host) - in - (* First destroy the Cluster_host objects of the slaves *) - List.iter - (fun cluster_host -> - (* We need to run this code on the slave *) - Helpers.call_api_functions ~__context (fun rpc session_id -> - Client.Client.Cluster_host.destroy ~rpc ~session_id ~self:cluster_host) - ) - slave_cluster_hosts; + (* Set pool_autojoin:false and try to destroy slave cluster_hosts *) + pool_destroy_common ~__context ~self ~force:false; + (* Then destroy the Cluster_host of the pool master and the Cluster itself *) Helpers.call_api_functions ~__context (fun rpc session_id -> Client.Client.Cluster.destroy ~rpc ~session_id ~self) let pool_resync ~__context ~(self : API.ref_Cluster) = List.iter - (fun host -> log_and_ignore_exn - (fun () -> + (fun host -> log_and_ignore_exn (fun () -> Xapi_cluster_host.create_as_necessary ~__context ~host; Xapi_cluster_host.resync_host ~__context ~host; if is_clustering_disabled_on_host ~__context host diff --git a/ocaml/xapi/xapi_cluster.mli b/ocaml/xapi/xapi_cluster.mli index de9a2d5efec..639ebfea14b 100644 --- a/ocaml/xapi/xapi_cluster.mli +++ b/ocaml/xapi/xapi_cluster.mli @@ -46,8 +46,11 @@ val pool_create : __context:Context.t -> val pool_force_destroy : __context:Context.t -> self:API.ref_Cluster -> unit (** [pool_force_destroy ~__context ~self] is the implementation of the XenAPI method 'Cluster.pool_force_destroy'. This is a convenience function that - attempts to force destroy the Cluster_host objects for all hosts in the pool - and then destroys the Cluster object if it was successful. *) + first attempts to destroy the Cluster_host objects for all hosts in the pool. + Any surviving cluster_hosts are force destroyed, any remaining after that are + forgotten, and any cluster_hosts for which forget fails will be deleted. After + this, the cluster is destroyed, unless there are still cluster_hosts remaining, + in which case the call raises an API error. *) val pool_destroy : __context:Context.t -> self:API.ref_Cluster -> unit (** [pool_destroy ~__context ~self] is the implementation of the XenAPI