Reapply "CA-403867: Block pool join if IP not configured on cluster n…

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 () ;