Merge pull request #5647 from Vincent-lau/private/shul2/corosync3-upg…

…rade-fist

CP-49635: Add FIST point for corosync upgrade

ocaml/xapi/xapi_clustering.ml

@@ -328,19 +328,22 @@ let rpc ~__context =
 
 let maybe_switch_cluster_stack_version ~__context ~self ~cluster_stack =
   if Xapi_cluster_helpers.corosync3_enabled ~__context then
-    let dbg = Context.string_of_task_and_tracing __context in
-    let result =
-      Cluster_client.LocalClient.switch_cluster_stack (rpc ~__context) dbg
-        cluster_stack
-    in
-    match Idl.IdM.run @@ Cluster_client.IDL.T.get result with
-    | Ok () ->
-        debug "cluster stack switching was successful for cluster_host: %s"
-          (Ref.string_of self)
-    | Error error ->
-        warn "Error encountered when switching cluster stack cluster_host %s"
-          (Ref.string_of self) ;
-        handle_error error
+    if Xapi_fist.fail_corosync_upgrade () then
+      handle_error (InternalError "simulated corosync upgrade failure")
+    else
+      let dbg = Context.string_of_task_and_tracing __context in
+      let result =
+        Cluster_client.LocalClient.switch_cluster_stack (rpc ~__context) dbg
+          cluster_stack
+      in
+      match Idl.IdM.run @@ Cluster_client.IDL.T.get result with
+      | Ok () ->
+          debug "cluster stack switching was successful for cluster_host: %s"
+            (Ref.string_of self)
+      | Error error ->
+          warn "Error encountered when switching cluster stack cluster_host %s"
+            (Ref.string_of self) ;
+          handle_error error
 
 let assert_cluster_host_quorate ~__context ~self =
   (* With the latest kernel GFS2 would hang on mount if clustering is not working yet,

ocaml/xapi/xapi_fist.ml

@@ -69,6 +69,9 @@ let reconfigure_host () = fistpoint "reconfigure_host"
 (** allow starting up a corosync2 cluster *)
 let allow_corosync2 () = fistpoint "allow_corosync2"
 
+(** Make the current node fail the corosync upgrade *)
+let fail_corosync_upgrade () = fistpoint "fail_corosync_upgrade"
+
 (** Raise MTC_EXIT_CAN_NOT_ACCESS_STATEFILE *)
 let ha_cannot_access_statefile () = fistpoint "ha_cannot_access_statefile"