CA-400060: Reject pool join if sm features mismatch

Implement a new `assert_sm_features_compatiable` in pre_join_checks so
that if the joining host does not have compatible sm features, it will
be denied entry into the pool.

Signed-off-by: Vincent Liu <[email protected]>

ocaml/idl/datamodel_errors.ml

@@ -890,6 +890,13 @@ let _ =
       "The host joining the pool has different CA certificates from the pool \
        coordinator while using the same name, uninstall them and try again."
     () ;
+  error Api_errors.pool_joining_sm_features_incompatible
+    ["pool_sm_ref"; "candidate_sm_ref"]
+    ~doc:
+      "The host joining the pool has an incompatible set of sm features from \
+       the pool coordinator. Make sure the sm are of the same versions and try \
+       again."
+    () ;
 
   (* External directory service *)
   error Api_errors.subject_cannot_be_resolved []

ocaml/xapi-consts/api_errors.ml

@@ -754,6 +754,9 @@ let pool_joining_host_tls_verification_mismatch =
 let pool_joining_host_ca_certificates_conflict =
   add_error "POOL_JOINING_HOST_CA_CERTIFICATES_CONFLICT"
 
+let pool_joining_sm_features_incompatible =
+  add_error "POOL_JOINING_SM_FEATURES_INCOMPATIBLE"
+
 (*workload balancing*)
 let wlb_not_initialized = add_error "WLB_NOT_INITIALIZED"
 

ocaml/xapi/xapi_pool.ml

@@ -839,6 +839,52 @@ let pre_join_checks ~__context ~rpc ~session_id ~force =
         )
     )
   in
+  let assert_sm_features_compatiable () =
+    (* We consider the case where coor has FOO/m, and the candidate having FOO/n,
+       where n >= m, to be compatible. Not vice versa. *)
+    let features_compatible coor_features candidate_features =
+      (* The pool features must not be reduced or downgraded, although it is fine
+         the other way around. *)
+      Smint.compat_features coor_features candidate_features = coor_features
+    in
+
+    let master_sms = Client.SM.get_all ~rpc ~session_id in
+    List.iter
+      (fun sm ->
+        let master_sm_type = Client.SM.get_type ~rpc ~session_id ~self:sm in
+        let candidate_sm_ref, candidate_sm_rec =
+          match
+            Db.SM.get_records_where ~__context
+              ~expr:(Eq (Field "type", Literal master_sm_type))
+          with
+          | [(sm_ref, sm_rec)] ->
+              (sm_ref, sm_rec)
+          | _ ->
+              raise
+                Api_errors.(
+                  Server_error
+                    ( pool_joining_sm_features_incompatible
+                    , [Ref.string_of sm; ""]
+                    )
+                )
+        in
+
+        let coor_sm_features =
+          Client.SM.get_features ~rpc ~session_id ~self:sm
+        in
+        let candidate_sm_features = candidate_sm_rec.API.sM_features in
+        if not (features_compatible coor_sm_features candidate_sm_features) then
+          raise
+            Api_errors.(
+              Server_error
+                ( pool_joining_sm_features_incompatible
+                , [Ref.string_of sm; Ref.string_of candidate_sm_ref]
+                )
+            )
+      )
+      master_sms
+  in
+
   (* call pre-join asserts *)
   assert_pool_size_unrestricted () ;
   assert_management_interface_exists () ;
@@ -872,7 +918,8 @@ let pre_join_checks ~__context ~rpc ~session_id ~force =
   assert_tls_verification_matches () ;
   assert_ca_certificates_compatible () ;
   assert_not_in_updating_on_me () ;
-  assert_no_hosts_in_updating ()
+  assert_no_hosts_in_updating () ;
+  assert_sm_features_compatiable ()
 
 let rec create_or_get_host_on_master __context rpc session_id (host_ref, host) :
     API.ref_host =