Backport: Add pool join check CP-23026: pool/host must have same "enforced" updates

ocaml/client_records/records.ml

@@ -1032,6 +1032,7 @@ let pool_update_record rpc session_id update =
         make_field ~name:"installation-size"   ~get:(fun () -> Int64.to_string (x ()).API.pool_update_installation_size) ();
         make_field ~name:"hosts"               ~get:(fun () -> String.concat ", " (get_hosts ())) ~get_set:get_hosts ();
         make_field ~name:"after-apply-guidance" ~get:(fun () -> String.concat ", " (after_apply_guidance ())) ~get_set:after_apply_guidance ();
+        make_field ~name:"enforce-homogeneity" ~get:(fun () -> string_of_bool (x ()).API.pool_update_enforce_homogeneity) ();
       ]}
 
 let host_cpu_record rpc session_id host_cpu =

ocaml/idl/api_errors.ml

@@ -306,6 +306,9 @@ let pool_joining_host_must_have_physical_management_nic = "POOL_JOINING_HOST_MUS
 let pool_joining_external_auth_mismatch = "POOL_JOINING_EXTERNAL_AUTH_MISMATCH"
 let pool_joining_host_must_have_same_product_version = "POOL_JOINING_HOST_MUST_HAVE_SAME_PRODUCT_VERSION"
 let pool_joining_host_must_only_have_physical_pifs = "POOL_JOINING_HOST_MUST_ONLY_HAVE_PHYSICAL_PIFS"
+let pool_joining_host_must_have_same_api_version = "POOL_JOINING_HOST_MUST_HAVE_SAME_API_VERSION"
+let pool_joining_host_must_have_same_db_schema = "POOL_JOINING_HOST_MUST_HAVE_SAME_DB_SCHEMA"
+
 
 (*workload balancing*)
 let wlb_not_initialized = "WLB_NOT_INITIALIZED"

ocaml/idl/datamodel.ml

@@ -879,6 +879,10 @@ let _ =
     ~doc:"The pool failed to disable the external authentication of at least one host." ();
   error Api_errors.pool_auth_disable_failed_permission_denied ["host";"message"]
     ~doc:"The pool failed to disable the external authentication of at least one host." ();
+  error Api_errors.pool_joining_host_must_have_same_api_version ["host_api_version";"master_api_version"]
+    ~doc:"The host joining the pool must have the same API version as the pool master." ();
+  error Api_errors.pool_joining_host_must_have_same_db_schema ["host_db_schema";"master_db_schema"]
+    ~doc:"The host joining the pool must have the same database schema as the pool master." ();
 
   (* External directory service *)
   error Api_errors.subject_cannot_be_resolved []
@@ -4128,6 +4132,13 @@ let pool_update =
         field     ~in_product_since:rel_ely ~default_value:(Some (VSet [])) ~in_oss_since:None ~qualifier:StaticRO ~ty:(Set pool_update_after_apply_guidance) "after_apply_guidance" "What the client should do after this update has been applied.";
         field     ~in_oss_since:None ~qualifier:StaticRO ~ty:(Ref _vdi) "vdi" "VDI the update was uploaded to";
         field     ~in_product_since:rel_ely ~in_oss_since:None ~qualifier:DynamicRO ~ty:(Set (Ref _host)) "hosts" "The hosts that have applied this update.";
+        field     ~in_product_since:rel_honolulu
+                  ~default_value:(Some (VBool false))
+                  ~in_oss_since:None
+                  ~qualifier:StaticRO
+                  ~ty:Bool
+                  "enforce_homogeneity"
+                  "Flag - if true, all hosts in a pool must apply this update";
       ]
     ()
 

ocaml/idl/datamodel_types.ml

@@ -56,6 +56,7 @@ let rel_indigo = "indigo"
 let rel_dundee = "dundee"
 let rel_dundee_plus = "dundee-plus"
 let rel_ely = "ely"
+let rel_honolulu = "honolulu"
 
 let release_order =
   [ rel_rio
@@ -79,6 +80,7 @@ let release_order =
   ; rel_dundee
   ; rel_dundee_plus
   ; rel_ely
+  ; rel_honolulu
   ]
 
 exception Unknown_release of string

ocaml/test/test_common.ml

@@ -350,9 +350,26 @@ let make_pvs_cache_storage ~__context ?(ref=Ref.make ()) ?(uuid=make_uuid ())
     ~ref ~uuid ~host ~sR ~site ~size ~vDI;
   ref
 
-let make_pool_update ~__context ?(ref=Ref.make ()) ?(uuid=make_uuid ())
-    ?(name_label="") ?(name_description="") ?(version="") ?(installation_size=0L) ?(key="")
-    ?(after_apply_guidance=[]) ?(vdi=Ref.null) () =
-  let update_info = Xapi_pool_update.{uuid; name_label; name_description; version; key; installation_size; after_apply_guidance} in
+let make_pool_update ~__context
+    ?(ref=Ref.make ())
+    ?(uuid=make_uuid ())
+    ?(name_label="")
+    ?(name_description="")
+    ?(version="")
+    ?(installation_size=0L)
+    ?(key="")
+    ?(after_apply_guidance=[])
+    ?(enforce_homogeneity=false)
+    ?(vdi=Ref.null) () =
+  let update_info = Xapi_pool_update.
+    { uuid
+    ; name_label
+    ; name_description
+    ; version
+    ; key
+    ; installation_size
+    ; after_apply_guidance
+    ; enforce_homogeneity
+    } in
   Xapi_pool_update.create_update_record ~__context ~update:ref ~update_info ~vdi;
   ref

ocaml/xapi/xapi_globs.ml

@@ -123,6 +123,8 @@ let _xapi_major = "xapi_major"
 let _xapi_minor = "xapi_minor"
 let _export_vsn = "export_vsn"
 let _dbv = "dbv"
+let _db_schema = "db_schema"
+
 
 (* When comparing two host versions, always treat a host that has platform_version defined as newer
  * than any host that does not have platform_version defined.

ocaml/xapi/xapi_pool.ml

@@ -111,32 +111,68 @@ let pre_join_checks ~__context ~rpc ~session_id ~force =
         raise (Api_errors.Server_error (code, ["The pool uses v6d. Pool edition list = " ^ pool_edn_list_str]))
   in
 
-  (* CA-73264 Applied patches must match *)
-  let assert_applied_patches_match () =
-    let get_patches patches get_pool_patch get_uuid =
-      let patch_refs = List.map (fun x -> get_pool_patch ~self:x) patches in
-      let patch_uuids = List.map (fun x -> get_uuid ~self:x) patch_refs in
-      patch_uuids in
-    let pool_patches = get_patches
-        (Client.Host.get_patches ~rpc ~session_id ~self:(get_master ~rpc ~session_id))
-        (Client.Host_patch.get_pool_patch ~rpc ~session_id)
-        (Client.Pool_patch.get_uuid ~rpc ~session_id) in
-    let host_patches = get_patches
-        (Db.Host.get_patches ~__context ~self:(Helpers.get_localhost ~__context))
-        (Db.Host_patch.get_pool_patch ~__context) (Db.Pool_patch.get_uuid ~__context) in
-    let string_of_patches ps = (String.concat " " (List.map (fun patch -> patch) ps)) in
-    let diff = (List.set_difference host_patches pool_patches) @
-               (List.set_difference pool_patches host_patches)in
-    if (List.length diff > 0) then begin
-      error "Pool.join failed because of patches mismatch";
-      error "Remote has %s" (string_of_patches pool_patches);
-      error "Local has %s" (string_of_patches host_patches);
-      raise (Api_errors.Server_error(Api_errors.pool_hosts_not_homogeneous,
-                                     [(Printf.sprintf "Patches applied differ: Remote has %s -- Local has %s"
-                                         (string_of_patches pool_patches) (string_of_patches host_patches))]))
+  let assert_api_version_matches () =
+    let master = get_master rpc session_id in
+    let candidate_slave = Helpers.get_localhost ~__context in
+    let master_major = Client.Host.get_API_version_major ~rpc ~session_id ~self:master in
+    let master_minor = Client.Host.get_API_version_minor ~rpc ~session_id ~self:master in
+    let slave_major = Db.Host.get_API_version_major ~__context ~self:candidate_slave in
+    let slave_minor = Db.Host.get_API_version_minor ~__context ~self:candidate_slave in
+    if master_major <> slave_major || master_minor <> slave_minor then
+    begin
+      error "The joining host's API version is %Ld.%Ld while the master's is %Ld.%Ld"
+        slave_major slave_minor master_major master_minor;
+      raise (Api_errors.Server_error(Api_errors.pool_joining_host_must_have_same_api_version,
+        [Printf.sprintf "%Ld.%Ld" slave_major slave_minor; Printf.sprintf "%Ld.%Ld" master_major master_minor;]))
+    end
+  in
+
+  let assert_db_schema_matches () =
+    let master = get_master rpc session_id in
+    let candidate_slave = Helpers.get_localhost ~__context in
+    let master_sw_version = Client.Host.get_software_version ~rpc ~session_id ~self:master in
+    let slave_sw_version = Db.Host.get_software_version ~__context ~self:candidate_slave in
+    let master_db_schema = try List.assoc Xapi_globs._db_schema master_sw_version with _ -> "" in
+    let slave_db_schema = try List.assoc Xapi_globs._db_schema slave_sw_version with _ -> "" in
+    if master_db_schema = "" || slave_db_schema = "" ||  master_db_schema <> slave_db_schema then
+    begin
+        error "The joining host's database schema is %s; the master's is %s"
+          slave_db_schema master_db_schema;
+        raise (Api_errors.Server_error(Api_errors.pool_joining_host_must_have_same_db_schema,
+          [slave_db_schema; master_db_schema]))
     end
   in
 
+  let assert_homogeneous_updates () =
+    let module S      = Helpers.StringSet in
+    let local_host    = Helpers.get_localhost ~__context in
+    let local_uuid    = Db.Host.get_uuid ~__context ~self:local_host in
+    let updates_on ~rpc ~session_id host =
+      Client.Host.get_updates ~rpc ~session_id ~self:host
+      |> List.map (fun self -> Client.Pool_update.get_record ~rpc ~session_id ~self)
+      |> List.filter (fun upd -> upd.API.pool_update_enforce_homogeneity = true)
+      |> List.map (fun upd -> upd.API.pool_update_uuid)
+      |> S.of_list in
+    let local_updates =
+      Helpers.call_api_functions ~__context (fun rpc session_id ->
+        updates_on ~rpc ~session_id local_host) in
+    (* iterate over all pool hosts and compare patches to local host *)
+    Client.Host.get_all rpc session_id |> List.iter (fun pool_host ->
+      let remote_updates = updates_on rpc session_id pool_host in
+      if not (S.equal local_updates remote_updates) then begin
+        let remote_uuid  = Client.Host.get_uuid rpc session_id pool_host in
+        let diff xs ys   = S.diff xs ys |> S.elements |> String.concat "," in
+        let reason       = [remote_uuid] in
+        error
+          "Pool join: Updates differ. Only on pool host %s: {%s} -- only on local host %s: {%s}"
+          remote_uuid
+          (diff remote_updates local_updates)
+          local_uuid
+          (diff local_updates remote_updates);
+        raise Api_errors.(Server_error(pool_hosts_not_homogeneous,reason))
+      end)
+  in
+
   (* CP-700: Restrict pool.join if AD configuration of slave-to-be does not match *)
   (* that of master of pool-to-join *)
   let assert_external_auth_matches () =
@@ -347,7 +383,10 @@ let pre_join_checks ~__context ~rpc ~session_id ~force =
   assert_external_auth_matches ();
   assert_restrictions_match ();
   assert_homogeneous_vswitch_configuration ();
-  assert_applied_patches_match ();
+  (* CA-247399: check first the API version and then the database schema *)
+  assert_api_version_matches ();
+  assert_db_schema_matches ();
+  assert_homogeneous_updates ();
   assert_homogeneous_primary_address_type ()
 
 let rec create_or_get_host_on_master __context rpc session_id (host_ref, host) : API.ref_host =

ocaml/xapi/xapi_pool_update.ml

@@ -44,6 +44,7 @@ type update_info = {
   key: string;
   installation_size: int64;
   after_apply_guidance: API.after_apply_guidance list;
+  enforce_homogeneity: bool; (* true = all hosts in a pool must have this update *)
 }
 
 (** Mount a filesystem somewhere, with optional type *)
@@ -258,6 +259,9 @@ let parse_update_info xml =
       with
       | _ -> []
     in
+    let enforce_homogeneity =
+      Vm_platform.is_true ~key:"enforce-homogeneity" ~platformdata:attr ~default:false
+    in
     let is_name_description_node = function
       | Xml.Element ("name-description", _, _) -> true
       | _ -> false
@@ -266,16 +270,15 @@ let parse_update_info xml =
       | Xml.Element("name-description", _, [ Xml.PCData s ]) -> s
       | _ -> raise (Api_errors.Server_error(Api_errors.invalid_update, ["missing <name-description> in update.xml"]))
     in
-    let update_info = {
-      uuid = uuid;
-      name_label = name_label;
-      name_description = name_description;
-      version = version;
-      key = Filename.basename key;
-      installation_size = installation_size;
-      after_apply_guidance = guidance;
-    } in
-    update_info
+      { uuid
+      ; name_label
+      ; name_description
+      ; version
+      ; key = Filename.basename key
+      ; installation_size
+      ; after_apply_guidance = guidance
+      ; enforce_homogeneity
+      }
   | _ -> raise (Api_errors.Server_error(Api_errors.invalid_update, ["missing <update> in update.xml"]))
 
 let extract_applied_update_info applied_uuid  =
@@ -368,6 +371,7 @@ let create_update_record ~__context ~update ~update_info ~vdi =
     ~key:update_info.key
     ~after_apply_guidance:update_info.after_apply_guidance
     ~vdi:vdi
+    ~enforce_homogeneity:update_info.enforce_homogeneity
 
 let introduce ~__context ~vdi =
   ignore(Unixext.mkdir_safe Xapi_globs.host_update_dir 0o755);