CA-432914: Don't let clusterd tracing setup fail Cluster_host.enable

ocaml/tests/test_cluster.ml

@@ -141,6 +141,54 @@ let test_enable () =
   ) ;
   pool_destroy ~__context ~self:cluster
 
+let test_enable_survives_observer_failure () =
+  let __context = Test_common.make_test_database () in
+  let cluster = create_cluster ~__context () in
+  let calls = ref [] in
+  let observer_failing_rpc ~__context call =
+    calls := call.Rpc.name :: !calls ;
+    if String.starts_with ~prefix:"Observer." call.Rpc.name then
+      Rpc.failure (Rpc.String "observer unavailable")
+    else
+      test_clusterd_rpc ~__context call
+  in
+  Context.set_test_clusterd_rpc __context (observer_failing_rpc ~__context) ;
+  let self =
+    match
+      Xapi_clustering.find_cluster_host ~__context
+        ~host:Helpers.(get_localhost ~__context)
+    with
+    | Some self ->
+        self
+    | None ->
+        Alcotest.fail "Couldn't find freshly-created cluster_host"
+  in
+  Db.Cluster_host.set_enabled ~__context ~self ~value:false ;
+  Xapi_cluster_host.enable ~__context ~self ;
+  Alcotest.(check bool)
+    "cluster_host is enabled although clusterd rejected its tracing config" true
+    (Db.Cluster_host.get_enabled ~__context ~self) ;
+  let calls = List.rev !calls in
+  let find_index p =
+    List.to_seq calls
+    |> Seq.mapi (fun i name -> (i, name))
+    |> Seq.find (fun (_, name) -> p name)
+    |> Option.map fst
+  in
+  let first_observer_call =
+    find_index (String.starts_with ~prefix:"Observer.")
+  in
+  let enable_call = find_index (String.equal "enable") in
+  Alcotest.(check bool)
+    "clusterd is enabled before its tracing is configured" true
+    ( match (enable_call, first_observer_call) with
+    | Some e, Some o ->
+        e < o
+    | _ ->
+        false
+    ) ;
+  pool_destroy ~__context ~self:cluster
+
 let test_invalid_parameters () =
   let __context = Test_common.make_test_database () in
   let cluster_stack = "invalid_cluster_stack" in
@@ -242,6 +290,10 @@ let test =
   [
     ("test_create_destroy_service_status", `Quick, test_create_destroy_status)
   ; ("test_enable", `Quick, test_enable)
+  ; ( "test_enable_survives_observer_failure"
+    , `Quick
+    , test_enable_survives_observer_failure
+    )
   ; ("test_invalid_parameters", `Quick, test_invalid_parameters)
   ; ("test_create_cleanup", `Quick, test_create_cleanup)
   ; ("test_get_network_succeeds", `Quick, test_get_network_succeeds)

ocaml/xapi/xapi_cluster_host.ml

@@ -170,6 +170,15 @@ let join_internal ~__context ~self =
           handle_error error
   )
 
+(* Tracing configuration must never decide whether clustering starts *)
+let initialise_clusterd_observer ~__context =
+  try
+    Xapi_observer.initialise_observer ~__context
+      Xapi_observer_components.Xapi_clusterd
+  with e ->
+    warn "%s: failed to initialise tracing for xapi-clusterd: %s" __FUNCTION__
+      (Printexc.to_string e)
+
 (* Enable cluster_host in client layer via clusterd *)
 let resync_host ~__context ~host =
   match find_cluster_host ~__context ~host with
@@ -200,8 +209,7 @@ let resync_host ~__context ~host =
           if not (Db.Cluster_host.get_joined ~__context ~self) then (
             join_internal ~__context ~self ;
             Watcher.create_as_necessary ~__context ~host ;
-            Xapi_observer.initialise_observer ~__context
-              Xapi_observer_components.Xapi_clusterd
+            initialise_clusterd_observer ~__context
           ) else if Db.Cluster_host.get_enabled ~__context ~self then (
             (* [enable] unconditionally invokes low-level enable operations and is idempotent.
                RPU reformats partition, losing service status, never re-enables clusterd *)
@@ -342,8 +350,6 @@ let enable ~__context ~self =
         Xapi_clustering.Daemon.enable ~__context
       ) ;
       Watcher.create_as_necessary ~__context ~host ;
-      Xapi_observer.initialise_observer ~__context
-        Xapi_observer_components.Xapi_clusterd ;
       let verify = Stunnel_client.get_verify_by_default () in
       set_tls_config ~__context ~self ~verify ;
       let open Cluster_interface in
@@ -364,7 +370,8 @@ let enable ~__context ~self =
       | Ok () ->
           Db.Cluster_host.set_enabled ~__context ~self ~value:true ;
           debug "Cluster_host.enable was successful for cluster_host: %s"
-            (Ref.string_of self)
+            (Ref.string_of self) ;
+          initialise_clusterd_observer ~__context
       | Error error ->
           warn "Error encountered when enabling cluster_host %s"
             (Ref.string_of self) ;