diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index ad4fdec2e03..ff438df8bef 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -963,6 +963,7 @@ module PIF = struct ~params: [ Ref _pif, "self", "Reference to the object" ; Bool, "value", "New value to set" ] ~allowed_roles:_R_POOL_OP + ~errs:[Api_errors.clustering_enabled_on_network] () let ip_configuration_mode = Enum ("ip_configuration_mode", @@ -982,6 +983,7 @@ module PIF = struct ] ~in_product_since:rel_miami ~allowed_roles:_R_POOL_OP + ~errs:[Api_errors.clustering_enabled_on_network] () let ipv6_configuration_mode = Enum ("ipv6_configuration_mode", @@ -1001,6 +1003,7 @@ module PIF = struct ] ~lifecycle:[Prototyped, rel_tampa, ""] ~allowed_roles:_R_POOL_OP + ~errs:[Api_errors.clustering_enabled_on_network] () let primary_address_type = Enum ("primary_address_type", @@ -1048,7 +1051,8 @@ module PIF = struct ~params:[Ref _pif, "self", "The PIF object to destroy"] ~in_product_since:rel_miami ~allowed_roles:_R_POOL_OP - ~errs:[Api_errors.pif_tunnel_still_exists] + ~errs:[ Api_errors.pif_tunnel_still_exists + ; Api_errors.clustering_enabled_on_network] () let pool_introduce_params first_rel = diff --git a/ocaml/quicktest/quicktest.ml b/ocaml/quicktest/quicktest.ml index 3e7a4b133fb..8cdb896aba5 100644 --- a/ocaml/quicktest/quicktest.ml +++ b/ocaml/quicktest/quicktest.ml @@ -847,6 +847,7 @@ let _ = "cbt"; "import_raw_vdi"; "pbd-bvt"; + "reconfigure-ip-cluster"; ] in let default_tests = List.filter (fun x -> not(List.mem x [ "lifecycle"; "vhd" ])) all_tests in @@ -883,6 +884,7 @@ let _ = maybe_run_test "pbd-bvt" (fun () -> Quicktest_bvt.start s !rpc); maybe_run_test "cbt" (fun () -> Quicktest_cbt.test s); maybe_run_test "vm-placement" Quicktest_vm_placement.run_from_within_quicktest; + maybe_run_test "reconfigure-ip-cluster" (fun () -> Quicktest_cluster.test s); maybe_run_test "storage" (fun () -> Quicktest_storage.go s); if not !using_unix_domain_socket then maybe_run_test "http" Quicktest_http.run_from_within_quicktest; maybe_run_test "event" event_next_unblocking_test; diff --git a/ocaml/quicktest/quicktest_cluster.ml b/ocaml/quicktest/quicktest_cluster.ml new file mode 100644 index 00000000000..0b8948686ce --- /dev/null +++ b/ocaml/quicktest/quicktest_cluster.ml @@ -0,0 +1,92 @@ + +open Quicktest_common +(* provide test record type and make_test, start, + * debug, success, and failed test functions *) + +open Client +(* provide rpc ref *) + +module C = Client + +let is_empty = function | [] -> true | _ -> false + +(* [failed test.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 + * [failed test string_of_failure] *) +exception Abort_test of string + +(** --- Helpers for reconfiguration --- *) + +let reconfigure_ipv4 ~session_id ~self ~dNS = + let netmask = C.PIF.get_netmask ~session_id ~rpc:!rpc ~self in + let iP = C.PIF.get_IP ~session_id ~rpc:!rpc ~self in + let gateway = C.PIF.get_gateway ~session_id ~rpc:!rpc ~self in + let mode = C.PIF.get_ip_configuration_mode ~session_id ~rpc:!rpc ~self in + C.PIF.reconfigure_ip ~session_id ~rpc:!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:!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:!rpc ~self in + let mode = C.PIF.get_ipv6_configuration_mode ~session_id ~rpc:!rpc ~self in + let iPv6 = List.hd iPv6_lst in + C.PIF.reconfigure_ipv6 ~session_id ~rpc:!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 = + make_test (Printf.sprintf "Testing reconfiguring %s with clustering." ip_string) 4 + in + try + start test; + + let dNS = C.PIF.get_DNS ~session_id ~rpc:!rpc ~self in + if ipv6 + then reconfigure_ipv6 ~session_id ~self ~dNS + else reconfigure_ipv4 ~session_id ~self ~dNS; + + failed test "PIF.reconfigure_ip should raise clustering_enabled_on_network." + with + | Api_errors.(Server_error(code,_)) when code=Api_errors.clustering_enabled_on_network + -> debug test (Printf.sprintf "%s raised as expected." Api_errors.clustering_enabled_on_network); + success test + | Api_errors.(Server_error(_,_)) -> () (* Don't fail on other API errors, only test clustering *) + | Abort_test s -> failed test s + | e -> failed test (ExnHelper.string_of_exn e) + +(** --- Check environment before calling test --- *) +let test session_id = + let test_all_pifs = make_test "Testing IP reconfiguration with and without clustering." 2 in + try + print_newline (); + start test_all_pifs; + print_newline (); + let pifs = Client.PIF.get_all ~session_id ~rpc:!rpc in + + List.iter + (fun self -> + let clustering = + let network = C.PIF.get_network ~session_id ~rpc:!rpc ~self in + C.Cluster.get_all ~session_id ~rpc:!rpc + |> List.filter + (fun cluster -> (C.Cluster.get_network ~session_id ~rpc:!rpc ~self:cluster) = network) + |> (fun lst -> not (is_empty lst)) + in + if clustering + then begin + test_reconfigure_ip ~ipv6:false ~session_id ~self + (* IPv6 clusters not yet supported, can run this test once that changes *) + (* test_reconfigure_ip ~ipv6:true ~session_id ~self *) + end + else + debug test_all_pifs "No cluster objects on this PIF, skipping tests." + ) pifs; + + success test_all_pifs + with e -> failed test_all_pifs (ExnHelper.string_of_exn e) diff --git a/ocaml/xapi/xapi_pif.ml b/ocaml/xapi/xapi_pif.ml index d58f3e9d188..bd9ca3edb06 100644 --- a/ocaml/xapi/xapi_pif.ml +++ b/ocaml/xapi/xapi_pif.ml @@ -443,8 +443,21 @@ let introduce_internal (* return ref of newly created pif record *) pif +(* Assertion passes if network has clusters attached but host has disabled clustering *) +let assert_no_clustering_enabled ~__context ~network ~host = + if not (Xapi_clustering.is_clustering_disabled_on_host ~__context host) + then + (Db.Cluster.get_refs_where ~__context + ~expr:Db_filter_types.(Eq(Field "network", Literal (Ref.string_of network)))) + |> function + | [] -> () + | _::_ -> raise Api_errors.(Server_error (clustering_enabled_on_network, [Ref.string_of network])) + (* Internal [forget] is passed a pre-built table [t] *) let forget_internal ~t ~__context ~self = + let network = Db.PIF.get_network ~__context ~self in + let host = Db.PIF.get_host ~__context ~self in + assert_no_clustering_enabled ~__context ~network ~host; if Db.PIF.get_managed ~__context ~self = true then Nm.bring_pif_down ~__context self; (* NB we are allowed to forget an interface which still exists *) @@ -623,6 +636,9 @@ let destroy ~__context ~self = let reconfigure_ipv6 ~__context ~self ~mode ~iPv6 ~gateway ~dNS = assert_pif_is_managed ~__context ~self; assert_no_protection_enabled ~__context ~self; + let network = Db.PIF.get_network ~__context ~self in + let host = Db.PIF.get_host ~__context ~self in + assert_no_clustering_enabled ~__context ~network ~host; if gateway <> "" then Helpers.assert_is_valid_ip `ipv6 "gateway" gateway; @@ -672,6 +688,9 @@ let reconfigure_ipv6 ~__context ~self ~mode ~iPv6 ~gateway ~dNS = let reconfigure_ip ~__context ~self ~mode ~iP ~netmask ~gateway ~dNS = assert_pif_is_managed ~__context ~self; assert_no_protection_enabled ~__context ~self; + let network = Db.PIF.get_network ~__context ~self in + let host = Db.PIF.get_host ~__context ~self in + assert_no_clustering_enabled ~__context ~network ~host; if mode = `Static then begin (* require these parameters if mode is static *) @@ -680,7 +699,7 @@ let reconfigure_ip ~__context ~self ~mode ~iP ~netmask ~gateway ~dNS = end; (* for all IP parameters, if they're not empty - * then check they contain valid IP address *) + * then check they contain valid IP address *) List.iter (fun (param, value) -> if value <> "" then Helpers.assert_is_valid_ip `ipv4 param value) ["IP",iP; "netmask",netmask; "gateway",gateway]; @@ -767,20 +786,13 @@ let set_property ~__context ~self ~name ~value = Nm.bring_pif_up ~__context pif ) (self :: vlan_pifs) -let pif_has_clustering_enabled ~__context (self : API.ref_PIF) network = - (Db.Cluster.get_refs_where ~__context - ~expr:Db_filter_types.(Eq(Field "network", Literal (Ref.string_of network)))) - |> function - | [] -> false - | a::_ -> true - let set_disallow_unplug ~__context ~self ~value = if (Db.PIF.get_disallow_unplug ~__context ~self) <> value then begin let network = Db.PIF.get_network ~__context ~self in - if pif_has_clustering_enabled ~__context self network - then raise Api_errors.(Server_error(clustering_enabled_on_network, [Ref.string_of network])) - else Db.PIF.set_disallow_unplug ~__context ~self ~value + let host = Db.PIF.get_host ~__context ~self in + assert_no_clustering_enabled ~__context ~network ~host; + Db.PIF.set_disallow_unplug ~__context ~self ~value end let rec unplug ~__context ~self =