CA-290471: fix wrong token timeout in XenCenter

ocaml/idl/datamodel_cluster.ml

@@ -17,6 +17,11 @@ let cluster_operation =
 
 let lifecycle = [Prototyped, rel_kolkata, ""]
 
+let lifecycle_timeout = [
+            Prototyped, rel_kolkata, "the unit is milliseconds";
+            Changed, rel_lima, "the unit is now seconds"
+          ]
+
 let timeout_params =
   [ {param_type=Float;
      param_name="token_timeout";
@@ -171,13 +176,13 @@ let t =
           ~ty:Bool "pool_auto_join" ~default_value:(Some (VBool true))
           "True if automatically joining new pool members to the cluster. This will be `true` in the first release"
 
-      ; field   ~qualifier:StaticRO ~lifecycle
-          ~ty:Int "token_timeout" ~default_value:(Some (VInt 20000L))
-          "The corosync token timeout in ms"
+      ; field   ~qualifier:StaticRO ~lifecycle:lifecycle_timeout
+          ~ty:Float "token_timeout" ~default_value:(Some (VFloat Constants.default_token_timeout_s))
+          "The corosync token timeout in seconds"
 
-      ; field   ~qualifier:StaticRO ~lifecycle
-          ~ty:Int "token_timeout_coefficient" ~default_value:(Some (VInt 1000L))
-          "The corosync token timeout coefficient in ms"
+      ; field   ~qualifier:StaticRO ~lifecycle:lifecycle_timeout
+          ~ty:Float "token_timeout_coefficient" ~default_value:(Some (VFloat Constants.default_token_timeout_coefficient_s))
+          "The corosync token timeout coefficient in seconds"
 
 
       ; field   ~qualifier:StaticRO ~lifecycle

ocaml/idl/datamodel_common.ml

@@ -8,7 +8,7 @@ open Datamodel_roles
               When introducing a new release, bump the schema minor version to the next hundred
               to leave a gap for potential hotfixes needing to increment the schema version.*)
 let schema_major_vsn = 5
-let schema_minor_vsn = 201
+let schema_minor_vsn = 202
 
 (* Historical schema versions just in case this is useful later *)
 let rio_schema_major_vsn = 5

ocaml/tests/test_cluster_host.ml

@@ -18,7 +18,9 @@ let create_cluster ~__context pool_auto_join =
   let cluster_ref = Ref.make () in
   let cluster_uuid = Uuidm.to_string (Uuidm.create `V4) in
   Db.Cluster.create ~__context ~ref:cluster_ref ~uuid:cluster_uuid ~cluster_token:"token"
-    ~cluster_stack:Constants.default_smapiv3_cluster_stack ~token_timeout:5000L ~token_timeout_coefficient:1000L ~allowed_operations:[]
+    ~cluster_stack:Constants.default_smapiv3_cluster_stack
+    ~token_timeout:Constants.default_token_timeout_s
+    ~token_timeout_coefficient:Constants.default_token_timeout_coefficient_s ~allowed_operations:[]
     ~current_operations:[] ~pool_auto_join ~cluster_config:[] ~other_config:[] ~pending_forget:[];
   cluster_ref
 

ocaml/tests/test_common.ml

@@ -498,7 +498,8 @@ let make_cluster_host ~__context ?(ref=Ref.make ()) ?(uuid=make_uuid ())
 let make_cluster_and_cluster_host ~__context ?(ref=Ref.make ()) ?(uuid=make_uuid ())
     ?(cluster_token="") ?(pIF=Ref.null) ?(cluster_stack=Constants.default_smapiv3_cluster_stack)
     ?(allowed_operations=[]) ?(current_operations=[]) ?(pool_auto_join=true)
-    ?(token_timeout=5000L) ?(token_timeout_coefficient=1000L) ?(cluster_config=[])
+    ?(token_timeout=Constants.default_token_timeout_s) 
+    ?(token_timeout_coefficient=Constants.default_token_timeout_coefficient_s) ?(cluster_config=[])
     ?(other_config=[]) ?(host=Ref.null) () =
   Db.Cluster.create ~__context ~ref ~uuid ~cluster_token ~pending_forget:[]
     ~cluster_stack ~allowed_operations ~current_operations ~pool_auto_join

ocaml/xapi/records.ml

@@ -2087,10 +2087,10 @@ let cluster_record rpc session_id cluster =
           ~get:(fun () -> (x ()).API.cluster_cluster_stack)
           ()
       ; make_field ~name:"token-timeout"
-          ~get:(fun () -> Int64.to_string((x ()).API.cluster_token_timeout))
+          ~get:(fun () -> string_of_float ((x ()).API.cluster_token_timeout))
           ()
       ; make_field ~name:"token-timeout-coefficient"
-          ~get:(fun () -> Int64.to_string((x ()).API.cluster_token_timeout_coefficient))
+          ~get:(fun () -> string_of_float ((x ()).API.cluster_token_timeout_coefficient))
           ()
       ; make_field ~name:"pending-forget" ~hidden:true
           ~get:(fun () -> String.concat "; " (x ()).API.cluster_pending_forget)

ocaml/xapi/xapi_cluster.ml

@@ -61,7 +61,7 @@ let create ~__context ~pIF ~cluster_stack ~pool_auto_join ~token_timeout ~token_
       | Result.Ok cluster_token ->
         D.debug "Got OK from LocalClient.create";
         Db.Cluster.create ~__context ~ref:cluster_ref ~uuid:cluster_uuid ~cluster_token ~cluster_stack ~pending_forget:[]
-          ~pool_auto_join ~token_timeout:token_timeout_ms ~token_timeout_coefficient:token_timeout_coefficient_ms ~current_operations:[] ~allowed_operations:[] ~cluster_config:[]
+          ~pool_auto_join ~token_timeout ~token_timeout_coefficient ~current_operations:[] ~allowed_operations:[] ~cluster_config:[]
           ~other_config:[];
         Db.Cluster_host.create ~__context ~ref:cluster_host_ref ~uuid:cluster_host_uuid ~cluster:cluster_ref ~host ~enabled:true ~pIF
           ~current_operations:[] ~allowed_operations:[] ~other_config:[];

ocaml/xapi/xapi_db_upgrade.ml

@@ -564,6 +564,21 @@ let upgrade_domain_type = {
       (Db.VM.get_all_records ~__context)
 }
 
+let upgrade_cluster_timeouts = {
+  description = "Upgrade cluster timeout units from milliseconds to seconds";
+  version = (fun x -> x < (5, 202)); (* the version where we switched to seconds *)
+  fn = fun ~__context ->
+    Db.Cluster.get_all ~__context
+    |> List.iter (fun self ->
+        let update_milliseconds getter setter =
+	  let value = getter ~__context ~self /. 1000. in
+	  setter ~__context ~self ~value
+        in
+        update_milliseconds Db.Cluster.get_token_timeout Db.Cluster.set_token_timeout;
+        update_milliseconds Db.Cluster.get_token_timeout_coefficient Db.Cluster.set_token_timeout_coefficient;
+    )
+}
+
 let rules = [
   upgrade_domain_type;
   upgrade_alert_priority;
@@ -589,6 +604,7 @@ let rules = [
   upgrade_recommendations_for_gpu_passthru;
   upgrade_vswitch_controller;
   default_vm_platform_device_model;
+  upgrade_cluster_timeouts;
 ]
 
 (* Maybe upgrade most recent db *)