From af142fc413928250c14fcb2b38f04fe8ba27ce73 Mon Sep 17 00:00:00 2001
From: Vincent Liu <shuntian.liu2@cloud.com>
Date: Thu, 20 Jun 2024 20:00:40 +0100
Subject: [PATCH] Add new internal API cstack_sync

This allows one to force sync the state of xapi db with the cluster
stack, useful for cluster API methods change the state of the cluster.

Signed-off-by: Vincent Liu <shuntian.liu2@cloud.com>
---
 ocaml/idl/datamodel_cluster.ml   | 11 +++++++++++
 ocaml/xapi/message_forwarding.ml |  8 ++++++++
 ocaml/xapi/xapi_cluster.ml       |  5 +++++
 ocaml/xapi/xapi_cluster.mli      | 10 ++++++++++
 ocaml/xapi/xapi_clustering.ml    |  3 ++-
 5 files changed, 36 insertions(+), 1 deletion(-)

diff --git a/ocaml/idl/datamodel_cluster.ml b/ocaml/idl/datamodel_cluster.ml
index 10c30bb540b..dba9b76c73b 100644
--- a/ocaml/idl/datamodel_cluster.ml
+++ b/ocaml/idl/datamodel_cluster.ml
@@ -169,6 +169,16 @@ let pool_resync =
     ~params:[(Ref _cluster, "self", "The cluster to resync")]
     ~lifecycle ~allowed_roles:_R_POOL_OP ~errs:[] ()
 
+let cstack_sync =
+  call ~name:"cstack_sync"
+    ~doc:
+      "Sync xapi db with the cluster stack synchronously, and generate alerts \
+       as needed. Only happens on the coordinator as this is where the cluster \
+       watcher performs updates."
+    ~params:[(Ref _cluster, "self", "The cluster to sync")]
+    ~hide_from_docs:true ~pool_internal:true ~lifecycle
+    ~allowed_roles:_R_POOL_OP ~errs:[] ()
+
 let t =
   create_obj ~name:_cluster ~descr:"Cluster-wide Cluster metadata"
     ~doccomments:[] ~gen_constructor_destructor:false ~gen_events:true
@@ -245,5 +255,6 @@ let t =
       ; pool_force_destroy
       ; pool_destroy
       ; pool_resync
+      ; cstack_sync
       ]
     ()
diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml
index e323bd4248b..34e420259b8 100644
--- a/ocaml/xapi/message_forwarding.ml
+++ b/ocaml/xapi/message_forwarding.ml
@@ -6419,6 +6419,14 @@ functor
                ) ;
                debug "Cluster.pool_resync for host %s" (Ref.string_of host)
            )
+
+      let cstack_sync ~__context ~self =
+        info "Cluster.cstack_sync cluster %s" (Ref.string_of self) ;
+        let local_fn = Local.Cluster.cstack_sync ~self in
+        let coor = Helpers.get_master ~__context in
+        do_op_on ~local_fn ~__context ~host:coor (fun session_id rpc ->
+            Client.Cluster.cstack_sync ~rpc ~session_id ~self
+        )
     end
 
     module Cluster_host = struct
diff --git a/ocaml/xapi/xapi_cluster.ml b/ocaml/xapi/xapi_cluster.ml
index cfc9147434b..26fc0317ac2 100644
--- a/ocaml/xapi/xapi_cluster.ml
+++ b/ocaml/xapi/xapi_cluster.ml
@@ -294,3 +294,8 @@ let pool_resync ~__context ~self:_ =
       )
 (* If host.clustering_enabled then resync_host should successfully
    find or create a matching cluster_host which is also enabled *)
+
+let cstack_sync ~__context ~self =
+  debug "%s: sync db data with cluster stack" __FUNCTION__ ;
+  Watcher.on_corosync_update ~__context ~cluster:self
+    ["Updates due to cluster api calls"]
diff --git a/ocaml/xapi/xapi_cluster.mli b/ocaml/xapi/xapi_cluster.mli
index a9a71f275ad..bcdc029c49b 100644
--- a/ocaml/xapi/xapi_cluster.mli
+++ b/ocaml/xapi/xapi_cluster.mli
@@ -74,3 +74,13 @@ val pool_resync : __context:Context.t -> self:API.ref_Cluster -> unit
     Cluster_host objects (ie., one for each host in the pool if the Cluster
     has [pool_auto_join] set. If there is a failure, this function must return
     an error that enables the administrator to fix the problem. *)
+
+val cstack_sync : __context:Context.t -> self:API.ref_Cluster -> unit
+(** [cstack_sync ~__context ~self] is the implementation of the internal XenAPI method,
+which synchronously performs a diagnostics call to xapi-clusterd and updates the
+xapi db according to the call. This is used internally by cluster-host-create/destroy
+to generate the correct alert as a result of the API call. The other part of the
+alerts generated due to network failure (e.g. a host left as its network is down)
+is handled by the cluster watcher. This call only happens on the coordinator as that
+is where the cluster watcher performs the updates, which shares the code with
+this function.  *)
diff --git a/ocaml/xapi/xapi_clustering.ml b/ocaml/xapi/xapi_clustering.ml
index a470546135d..eedc60290bc 100644
--- a/ocaml/xapi/xapi_clustering.ml
+++ b/ocaml/xapi/xapi_clustering.ml
@@ -531,7 +531,8 @@ module Watcher = struct
     while !Daemon.enabled do
       let m =
         Cluster_client.LocalClient.UPDATES.get (rpc ~__context)
-          "call cluster watcher" (Clock.Timer.span_to_s cluster_change_interval)
+          "call cluster watcher"
+          (Clock.Timer.span_to_s cluster_change_interval)
       in
       match Idl.IdM.run @@ Cluster_client.IDL.T.get m with
       | Ok updates -> (