CA-268511: Make PIF.disallow_unplug RO when clustering is enabled

ocaml/idl/datamodel.ml

@@ -954,6 +954,17 @@ module PIF = struct
              Api_errors.pif_has_fcoe_sr_in_use]
       ()
 
+  let set_disallow_unplug = call
+    ~name:"set_disallow_unplug"
+    ~doc:"Set whether unplugging the PIF is allowed"
+    ~hide_from_docs:false
+    ~in_oss_since:None
+    ~in_product_since:rel_orlando
+    ~params: [ Ref _pif, "self", "Reference to the object"
+             ; Bool, "value", "New value to set" ]
+    ~allowed_roles:_R_POOL_OP
+    ()
+
   let ip_configuration_mode = Enum ("ip_configuration_mode",
                                     [ "None", "Do not acquire an IP address";
                                       "DHCP", "Acquire an IP address by DHCP";
@@ -1135,6 +1146,7 @@ module PIF = struct
         introduce;
         forget;
         unplug;
+        set_disallow_unplug;
         plug;
         pool_introduce;
         db_introduce;
@@ -1167,7 +1179,7 @@ module PIF = struct
                   field ~in_oss_since:None ~ty:(Set(Ref _vlan)) ~in_product_since:rel_miami ~qualifier:DynamicRO "VLAN_slave_of" "Indicates which VLANs this interface transmits tagged traffic to";
                   field ~in_oss_since:None ~ty:Bool ~in_product_since:rel_miami ~qualifier:DynamicRO "management" "Indicates whether the control software is listening for connections on this interface" ~default_value:(Some (VBool false));
                   field ~in_product_since:rel_miami ~default_value:(Some (VMap [])) ~ty:(Map(String, String)) "other_config" "Additional configuration";
-                  field ~in_product_since:rel_orlando ~default_value:(Some (VBool false)) ~ty:Bool "disallow_unplug" "Prevent this PIF from being unplugged; set this to notify the management tool-stack that the PIF has a special use and should not be unplugged under any circumstances (e.g. because you're running storage traffic over it)";
+                  field ~in_product_since:rel_orlando ~qualifier:DynamicRO ~default_value:(Some (VBool false)) ~ty:Bool "disallow_unplug" "Prevent this PIF from being unplugged; set this to notify the management tool-stack that the PIF has a special use and should not be unplugged under any circumstances (e.g. because you're running storage traffic over it)";
                   field ~in_oss_since:None ~ty:(Set(Ref _tunnel)) ~lifecycle:[Published, rel_cowley, "Indicates to which tunnel this PIF gives access"] ~qualifier:DynamicRO "tunnel_access_PIF_of" "Indicates to which tunnel this PIF gives access";
                   field ~in_oss_since:None ~ty:(Set(Ref _tunnel)) ~lifecycle:[Published, rel_cowley, "Indicates to which tunnel this PIF provides transport"] ~qualifier:DynamicRO "tunnel_transport_PIF_of" "Indicates to which tunnel this PIF provides transport";
                   field ~in_oss_since:None ~ty:ipv6_configuration_mode ~lifecycle:[Prototyped, rel_tampa, ""] ~qualifier:DynamicRO "ipv6_configuration_mode" "Sets if and how this interface gets an IPv6 address" ~default_value:(Some (VEnum "None"));

ocaml/idl/datamodel_errors.ml

@@ -1090,7 +1090,9 @@ let _ =
   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"]
-    ~doc:"Force destroy failed on a Cluster_host while force destroying the cluster." ()
+    ~doc:"Force destroy failed on a Cluster_host while force destroying the cluster." ();
+  error Api_errors.clustering_enabled_on_network ["network"]
+    ~doc:"The network has cluster objects attached." ()
 
 let _ =
   message (fst Api_messages.ha_pool_overcommitted) ~doc:"Pool has become overcommitted: it can no longer guarantee to restart protected VMs if the configured number of hosts fail." ();

ocaml/tests/test_clustering.ml

@@ -313,11 +313,75 @@ let test_assert_pif_prerequisites () =
 let test_assert_pif_prerequisites =
   [ "test_assert_pif_prerequisites", `Quick, test_assert_pif_prerequisites ]
 
+
+(** Test PIF.disallow_unplug is RO when clustering is enabled *)
+let check_disallow_unplug expected_value __context pif msg =
+  Alcotest.(check bool) msg
+    (Db.PIF.get_disallow_unplug ~__context ~self:pif)
+    expected_value
+
+(* Need host and network to make PIF *)
+let make_host_network_pif ~__context =
+  let host = Test_common.make_host ~__context () in
+  let network = Test_common.make_network ~__context () in
+  let pif = Test_common.make_pif ~__context ~network ~host () in
+  (host, network, pif)
+
+(* Test PIF.set_disallow_unplug without cluster/cluster_host objects *)
+let test_disallow_unplug_no_clustering () =
+  let __context = Test_common.make_test_database () in
+  let host,network,pif = make_host_network_pif ~__context in
+
+  (* Test toggling disallow_unplug when disallow_unplug:false by default *)
+  check_disallow_unplug false __context pif
+    "check_disallow_unplug called by test_disallow_unplug_no_clustering when testing default config";
+  Xapi_pif.set_disallow_unplug ~__context ~self:pif ~value:true;
+  check_disallow_unplug true __context pif
+    "check_disallow_unplug called by test_disallow_unplug_no_clustering after setting disallow_unplug:true";
+
+  (* Test toggling disallow_unplug when initialised to true *)
+  let pif_no_unplug = Test_common.make_pif ~__context ~network ~host ~disallow_unplug:true () in
+  check_disallow_unplug true __context pif_no_unplug
+    "check_disallow_unplug called by test_disallow_unplug_no_clustering when initialising disallow_unplug:true";
+  Xapi_pif.set_disallow_unplug ~__context ~self:pif_no_unplug ~value:false;
+  check_disallow_unplug false __context pif_no_unplug
+    "check_disallow_unplug called by test_disallow_unplug_no_clustering after setting disallow_unplug:false"
+
+let test_disallow_unplug_with_clustering () =
+  let __context = Test_common.make_test_database () in
+  let host,network,pif = make_host_network_pif ~__context in
+  check_disallow_unplug false __context pif
+    "check_disallow_unplug called by test_disallow_unplug_with_clustering to check default config";
+
+  (* PIF.disallow_unplug must be true in order to enable clustering *)
+  Xapi_pif.set_disallow_unplug ~__context ~self:pif ~value:true;
+  check_disallow_unplug true __context pif
+    "check_disallow_unplug called by test_disallow_unplug_with_clustering after setting disallow_unplug:true";
+
+  (* PIF.disallow_unplug should become RO upon introduce cluster_host object *)
+  let _ = Test_common.make_cluster_and_cluster_host ~__context ~network ~host () in
+  Alcotest.check_raises
+    "check_disallow_unplug called by test_disallow_unplug_with_clustering after attaching cluster and cluster_host to network"
+    (Api_errors.(Server_error(clustering_enabled_on_network, [Ref.string_of network])))
+    (fun () -> Xapi_pif.set_disallow_unplug ~__context ~self:pif ~value:true);
+
+    (* PIF.set_disallow_unplug should raise same error even when value is the same *)
+  Alcotest.check_raises
+    "PIF.set_disallow_unplug:true called by test_disallow_unplug_with_clustering after attaching cluster and cluster_host to network"
+    (Api_errors.(Server_error(clustering_enabled_on_network, [Ref.string_of network])))
+    (fun () -> Xapi_pif.set_disallow_unplug ~__context ~self:pif ~value:true)
+
+let test_disallow_unplug_ro_with_clustering_enabled =
+  [ "test_disallow_unplug_no_clustering", `Quick, test_disallow_unplug_no_clustering
+  ; "test_disallow_unplug_with_clustering", `Quick, test_disallow_unplug_with_clustering
+  ]
+
 let test =
   ( test_get_required_cluster_stacks
   @ test_find_cluster_host
   @ test_assert_cluster_host_enabled
   @ test_assert_cluster_host_is_enabled_for_matching_sms
   @ test_clustering_lock_only_taken_if_needed
   @ test_assert_pif_prerequisites
+  @ test_disallow_unplug_ro_with_clustering_enabled
   )

ocaml/xapi-consts/api_errors.ml

@@ -590,3 +590,4 @@ let clustering_disabled = "CLUSTERING_DISABLED"
 let cluster_does_not_have_one_node = "CLUSTER_DOES_NOT_HAVE_ONE_NODE"
 let no_compatible_cluster_host = "NO_COMPATIBLE_CLUSTER_HOST"
 let cluster_force_destroy_failed = "CLUSTER_FORCE_DESTROY_FAILED"
+let clustering_enabled_on_network = "CLUSTERING_ENABLED_ON_NETWORK"

ocaml/xapi/message_forwarding.ml

@@ -3110,6 +3110,10 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct
       let local_fn = Local.PIF.set_property ~self ~name ~value in
       do_op_on ~local_fn ~__context ~host (fun session_id rpc -> Client.PIF.set_property rpc session_id self name value)
 
+    let set_disallow_unplug ~__context ~self ~value =
+      info "PIF.set_disallow_unplug: PIF uuid = %s; value = %s" (pif_uuid ~__context self) (string_of_bool value);
+      Local.PIF.set_disallow_unplug ~__context ~self ~value
+
     let scan ~__context ~host =
       info "PIF.scan: host = '%s'" (host_uuid ~__context host);
       let local_fn = Local.PIF.scan ~host in

ocaml/xapi/xapi_pif.ml

@@ -767,6 +767,19 @@ 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 =
+  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 rec unplug ~__context ~self =
   assert_pif_is_managed ~__context ~self;
   assert_no_protection_enabled ~__context ~self;

ocaml/xapi/xapi_pif.mli

@@ -142,6 +142,13 @@ val set_property :
   value:string ->
   unit
 
+(* Set disallow_unplug on a PIF *)
+val set_disallow_unplug :
+  __context:Context.t ->
+  self:API.ref_PIF ->
+  value:bool ->
+  unit
+
 (** Attempt to bring down the PIF: disconnect the underlying network interface from
  *  its bridge and disable the interface. *)
 val unplug : __context:Context.t -> self:API.ref_PIF -> unit