CA-102761: To check if RPU is actually in progress before enabling HA

ocaml/xapi/db_gc.ml

@@ -383,11 +383,7 @@ let detect_rolling_upgrade ~__context =
 		(* If my platform version is different to any host (including myself) then we're in a rolling upgrade mode *)
 		(* NB: it is critical this code runs once in the master of a pool of one before the dbsync, since this
 		   is the only time at which the master's Version will be out of sync with its database record *)
-		let all_hosts = Db.Host.get_all ~__context in
-		let platform_versions = List.map (fun host -> Helpers.version_string_of ~__context host) all_hosts in
-
-		let is_different_to_me platform_version = platform_version <> Version.platform_version in
-		let actually_in_progress = List.fold_left (||) false (List.map is_different_to_me platform_versions) in
+		let actually_in_progress = Helpers.pool_has_different_host_platform_versions ~__context in
 		(* Check the current state of the Pool as indicated by the Pool.other_config:rolling_upgrade_in_progress *)
 		let pools = Db.Pool.get_all ~__context in
 		match pools with
@@ -398,6 +394,7 @@ let detect_rolling_upgrade ~__context =
 					List.mem_assoc Xapi_globs.rolling_upgrade_in_progress (Db.Pool.get_other_config ~__context ~self:pool) in
 				(* Resynchronise *)
 				if actually_in_progress <> pool_says_in_progress then begin
+					let platform_versions = List.map (fun host -> Helpers.version_string_of ~__context host) (Db.Host.get_all ~__context) in
 					debug "xapi platform version = %s; host platform versions = [ %s ]"
 						Version.platform_version (String.concat "; " platform_versions);
 

ocaml/xapi/helpers.ml

@@ -556,6 +556,12 @@ let assert_host_versions_not_decreasing :
 		if not (host_versions_not_decreasing ~__context ~host_from ~host_to) then
 			raise (Api_errors.Server_error (Api_errors.not_supported_during_upgrade, []))
 
+let pool_has_different_host_platform_versions ~__context =
+	let all_hosts = Db.Host.get_all ~__context in
+	let platform_versions = List.map (fun host -> version_string_of ~__context host) all_hosts in
+	let is_different_to_me platform_version = platform_version <> Version.platform_version in
+	List.fold_left (||) false (List.map is_different_to_me platform_versions)
+
 (** Indicates whether ballooning is enabled for the given virtual machine. *)
 let ballooning_enabled_for_vm ~__context vm_record =
 	not vm_record.API.vM_is_control_domain
@@ -992,3 +998,4 @@ let force_loopback_vbd ~__context =
 	let pool = get_pool ~__context in
 	let other_config = Db.Pool.get_other_config ~__context ~self:pool in
 	List.mem_assoc "force_loopback_vbd" other_config
+

ocaml/xapi/xapi_pool.ml

@@ -1133,13 +1133,15 @@ let slave_network_report ~__context ~phydevs ~dev_to_mac ~dev_to_mtu ~slave_host
 (*
   Dbsync_slave.create_physical_networks ~__context phydevs dev_to_mac dev_to_mtu slave_host
 *)
-
 (* Let's only process one enable/disable at a time. I would have used an allowed_operation for this but
    it would involve a datamodel change and it's too late for Orlando. *)
 let enable_disable_m = Mutex.create ()
 let enable_ha ~__context ~heartbeat_srs ~configuration = 
-	Helpers.assert_rolling_upgrade_not_in_progress ~__context;
-	Mutex.execute enable_disable_m (fun () -> Xapi_ha.enable __context heartbeat_srs configuration)
+	if not (Helpers.pool_has_different_host_platform_versions ~__context)
+	then Mutex.execute enable_disable_m (fun () -> Xapi_ha.enable __context heartbeat_srs configuration)
+	else
+		raise (Api_errors.Server_error (Api_errors.not_supported_during_upgrade, []))
+
 let disable_ha ~__context = Mutex.execute enable_disable_m (fun () -> Xapi_ha.disable __context)
 
 let ha_prevent_restarts_for ~__context ~seconds = Xapi_ha.ha_prevent_restarts_for __context seconds