CA-403867: Block pool join if IP not configured on cluster network

Refix with some review comments addressed.

To join a host into a pool with cluster enabled, the host must have one
and only one IP configured on the joining cluster network.

If not, after the host joinied the pool, GFS2 SR cannot be plugged on
the joined host because an IP is required in the cluster network.

Pool join in this scenario has been blocked in XenCenter, here we will
block it inside xapi.

Signed-off-by: Gang Ji <[email protected]>

Author: gangj

ocaml/idl/datamodel_errors.ml

@@ -897,6 +897,14 @@ let _ =
        the pool coordinator. Make sure the sm are of the same versions and try \
        again."
     () ;
+  error Api_errors.pool_joining_pool_cannot_enable_clustering_on_vlan_network
+    ["vlan"] ~doc:"The remote pool cannot enable clustering on vlan network" () ;
+  error Api_errors.pool_joining_host_must_have_only_one_IP_on_clustering_network
+    []
+    ~doc:
+      "The host joining the pool must have one and only one IP on the \
+       clustering network"
+    () ;
 
   (* External directory service *)
   error Api_errors.subject_cannot_be_resolved []

ocaml/xapi-consts/api_errors.ml

@@ -757,6 +757,12 @@ let pool_joining_host_ca_certificates_conflict =
 let pool_joining_sm_features_incompatible =
   add_error "POOL_JOINING_SM_FEATURES_INCOMPATIBLE"
 
+let pool_joining_pool_cannot_enable_clustering_on_vlan_network =
+  add_error "POOL_JOINING_POOL_CANNOT_ENABLE_CLUSTERING_ON_VLAN_NETWORK"
+
+let pool_joining_host_must_have_only_one_IP_on_clustering_network =
+  add_error "POOL_JOINING_HOST_MUST_HAVE_ONLY_ONE_IP_ON_CLUSTERING_NETWORK"
+
 (*workload balancing*)
 let wlb_not_initialized = add_error "WLB_NOT_INITIALIZED"
 

ocaml/xapi/xapi_pool.ml

@@ -112,6 +112,89 @@ let pre_join_checks ~__context ~rpc ~session_id ~force =
             )
         )
   in
+  let one_ip_configured_on_joining_cluster_network () =
+    let one_ip_configured_on_joining_cluster_network' cluster_host =
+      match Client.Cluster_host.get_PIF ~rpc ~session_id ~self:cluster_host with
+      | pif when pif = Ref.null ->
+          ()
+      | pif -> (
+        match Client.PIF.get_VLAN ~rpc ~session_id ~self:pif with
+        | vlan when vlan > 0L ->
+            error "Cannot join pool whose clustering is enabled on VLAN network" ;
+            raise
+              (Api_errors.Server_error
+                 ( Api_errors
+                   .pool_joining_pool_cannot_enable_clustering_on_vlan_network
+                 , [Int64.to_string vlan]
+                 )
+              )
+        | 0L | _ -> (
+            let clustering_bridges_in_pool =
+              ( match
+                  Client.PIF.get_bond_master_of ~rpc ~session_id ~self:pif
+                with
+              | [] ->
+                  [pif]
+              | bonds ->
+                  List.concat_map
+                    (fun bond ->
+                      Client.Bond.get_slaves ~rpc ~session_id ~self:bond
+                    )
+                    bonds
+              )
+              |> List.map (fun self ->
+                     Client.PIF.get_network ~rpc ~session_id ~self
+                 )
+              |> List.map (fun self ->
+                     Client.Network.get_bridge ~rpc ~session_id ~self
+                 )
+            in
+            match
+              Db.Host.get_PIFs ~__context
+                ~self:(Helpers.get_localhost ~__context)
+              |> List.filter (fun p ->
+                     List.exists
+                       (fun b ->
+                         let network = Db.PIF.get_network ~__context ~self:p in
+                         Db.Network.get_bridge ~__context ~self:network = b
+                       )
+                       clustering_bridges_in_pool
+                     && Db.PIF.get_IP ~__context ~self:p <> ""
+                 )
+            with
+            | [_] ->
+                ()
+            | _ ->
+                error
+                  "Cannot join pool as the joining host needs to have one (and \
+                   only one) IP address on the network that will be used for \
+                   clustering." ;
+                raise
+                  (Api_errors.Server_error
+                     ( Api_errors
+                       .pool_joining_host_must_have_only_one_IP_on_clustering_network
+                     , []
+                     )
+                  )
+          )
+      )
+    in
+    match Client.Cluster_host.get_all ~rpc ~session_id with
+    | [] ->
+        ()
+    | ch :: _ -> (
+        let cluster =
+          Client.Cluster_host.get_cluster ~rpc ~session_id ~self:ch
+        in
+        match
+          Client.Cluster.get_pool_auto_join ~rpc ~session_id ~self:cluster
+        with
+        | false ->
+            ()
+        | true ->
+            one_ip_configured_on_joining_cluster_network' ch
+      )
+  in
   (* CA-26975: Pool edition MUST match *)
   let assert_restrictions_match () =
     let my_edition =
@@ -888,6 +971,7 @@ let pre_join_checks ~__context ~rpc ~session_id ~force =
   assert_management_interface_exists () ;
   ha_is_not_enable_on_me () ;
   clustering_is_not_enabled_on_me () ;
+  one_ip_configured_on_joining_cluster_network () ;
   ha_is_not_enable_on_the_distant_pool () ;
   assert_not_joining_myself () ;
   assert_i_know_of_no_other_hosts () ;