[477 merge]

ocaml/idl/datamodel.ml

@@ -963,7 +963,9 @@ module PIF = struct
     ~params: [ Ref _pif, "self", "Reference to the object"
              ; Bool, "value", "New value to set" ]
     ~allowed_roles:_R_POOL_OP
-    ~errs:[Api_errors.clustering_enabled_on_network]
+    ~errs:Api_errors.([ other_operation_in_progress
+                      ; clustering_enabled
+                      ])
     ()
 
   let ip_configuration_mode = Enum ("ip_configuration_mode",
@@ -983,7 +985,7 @@ module PIF = struct
               ]
       ~in_product_since:rel_miami
       ~allowed_roles:_R_POOL_OP
-      ~errs:[Api_errors.clustering_enabled_on_network]
+      ~errs:Api_errors.([ clustering_enabled ])
       ()
 
   let ipv6_configuration_mode = Enum ("ipv6_configuration_mode",
@@ -1003,7 +1005,7 @@ module PIF = struct
               ]
       ~lifecycle:[Prototyped, rel_tampa, ""]
       ~allowed_roles:_R_POOL_OP
-      ~errs:[Api_errors.clustering_enabled_on_network]
+      ~errs:Api_errors.([ clustering_enabled ])
       ()
 
   let primary_address_type = Enum ("primary_address_type",
@@ -1051,8 +1053,9 @@ module PIF = struct
       ~params:[Ref _pif, "self", "The PIF object to destroy"]
       ~in_product_since:rel_miami
       ~allowed_roles:_R_POOL_OP
-      ~errs:[ Api_errors.pif_tunnel_still_exists
-            ; Api_errors.clustering_enabled_on_network]
+      ~errs:Api_errors.([ pif_tunnel_still_exists
+                        ; clustering_enabled
+                        ])
       ()
 
   let pool_introduce_params first_rel =

ocaml/idl/datamodel_cluster.ml

@@ -17,9 +17,24 @@ let cluster_operation =
 
 let lifecycle = [Prototyped, rel_kolkata, ""]
 
-let timeout_params = [
-    {param_type=Float; param_name="token_timeout"; param_doc="Corosync token timeout in seconds"; param_release=kolkata_release; param_default=Some(VFloat Constants.default_token_timeout_s)};
-    {param_type=Float; param_name="token_timeout_coefficient"; param_doc="Corosync token timeout coefficient in seconds"; param_release=kolkata_release; param_default=Some(VFloat Constants.default_token_timeout_coefficient_s)};
+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";
+     param_doc="Corosync token timeout in seconds";
+     param_release=kolkata_release;
+     param_default=Some(VFloat Constants.default_token_timeout_s)};
+
+    {param_type=Float;
+     param_name="token_timeout_coefficient";
+     param_doc="Corosync token timeout coefficient in seconds";
+     param_release=kolkata_release;
+     param_default=Some(VFloat Constants.default_token_timeout_coefficient_s)};
+
   ]
 
 
@@ -28,10 +43,25 @@ let create = call
     ~doc:"Creates a Cluster object and one Cluster_host object as its first member"
     ~result:(Ref _cluster, "the new Cluster")
     ~versioned_params:
-            ([{param_type=Ref _network; param_name="network"; param_doc="the single network on which corosync carries out its inter-host communications"; param_release=kolkata_release; param_default=None};
-             {param_type=String; param_name="cluster_stack"; param_doc="simply the string 'corosync'. No other cluster stacks are currently supported"; param_release=kolkata_release; param_default=None};
-             {param_type=Bool; param_name="pool_auto_join"; param_doc="true if xapi is automatically joining new pool members to the cluster"; param_release=kolkata_release; param_default=None};
-      ] @timeout_params)
+      ([{param_type=(Ref _pif);
+         param_name="PIF";
+         param_doc="The PIF to connect the cluster's first cluster_host to";
+         param_release=kolkata_release;
+         param_default=None};
+
+        {param_type=String;
+         param_name="cluster_stack";
+         param_doc="simply the string 'corosync'. No other cluster stacks are currently supported";
+         param_release=kolkata_release;
+         param_default=None};
+
+        {param_type=Bool;
+         param_name="pool_auto_join";
+         param_doc="true if xapi is automatically joining new pool members to the cluster";
+         param_release=kolkata_release;
+         param_default=None};
+
+       ] @timeout_params)
     ~lifecycle
     ~allowed_roles:_R_POOL_ADMIN
     ()
@@ -46,14 +76,36 @@ let destroy = call
     ~allowed_roles:_R_POOL_ADMIN
     ()
 
+let get_network = call
+    ~name:"get_network"
+    ~doc:("Returns the network used by the cluster for inter-host communication, " ^
+          "i.e. the network shared by all cluster host PIFs")
+    ~result:(Ref _network, "network of cluster")
+    ~params:
+      [ Ref _cluster, "self", "the Cluster with the network"
+      ]
+    ~lifecycle
+    ~allowed_roles:_R_POOL_ADMIN
+    ()
+
 let pool_create = call
     ~name:"pool_create"
     ~doc:"Attempt to create a Cluster from the entire pool"
     ~result:(Ref _cluster, "the new Cluster")
     ~versioned_params:
-            ([{param_type=Ref _network; param_name="network"; param_doc="the single network on which corosync carries out its inter-host communications"; param_release=kolkata_release; param_default=None};
-             {param_type=String; param_name="cluster_stack"; param_doc="simply the string 'corosync'. No other cluster stacks are currently supported"; param_release=kolkata_release; param_default=None};
-      ] @ timeout_params)
+      ([{param_type=Ref _network;
+         param_name="network";
+         param_doc="the single network on which corosync carries out its inter-host communications";
+         param_release=kolkata_release;
+         param_default=None};
+
+        {param_type=String;
+         param_name="cluster_stack";
+         param_doc="simply the string 'corosync'. No other cluster stacks are currently supported";
+         param_release=kolkata_release;
+         param_default=None};
+
+       ] @ timeout_params)
     ~lifecycle
     ~allowed_roles:_R_POOL_ADMIN
     ()
@@ -79,12 +131,12 @@ let pool_destroy = call
     ()
 
 let pool_resync = call
-  ~name:"pool_resync"
-  ~doc:"Resynchronise the cluster_host objects across the pool. Creates them where they need creating and then plugs them"
-  ~params:[ Ref _cluster, "self", "The cluster to resync"]
-  ~lifecycle
-  ~allowed_roles:_R_POOL_ADMIN
-  ()
+    ~name:"pool_resync"
+    ~doc:"Resynchronise the cluster_host objects across the pool. Creates them where they need creating and then plugs them"
+    ~params:[ Ref _cluster, "self", "The cluster to resync"]
+    ~lifecycle
+    ~allowed_roles:_R_POOL_ADMIN
+    ()
 
 let t =
   create_obj
@@ -105,9 +157,10 @@ let t =
           ~ty:(Set (Ref _cluster_host)) "cluster_hosts"
           "A list of the cluster_host objects associated with the Cluster"
 
-      ; field   ~qualifier:StaticRO ~lifecycle
-          ~ty:(Ref _network) "network" ~default_value:(Some (VRef null_ref))
-          "Reference to the single network on which corosync carries out its inter-host communications"
+      ; field ~qualifier:DynamicRO ~lifecycle:[ Prototyped, rel_lima, "" ]
+          ~ty:(Set String) "pending_forget" ~default_value:(Some (VSet []))
+          "Internal field used by Host.destroy to store the IP of cluster members \
+           marked as permanently dead but not yet removed"
 
       ; field   ~qualifier:StaticRO ~lifecycle
           ~ty:String "cluster_token" ~default_value:(Some (VString ""))
@@ -119,17 +172,17 @@ let t =
 
       ] @ (allowed_and_current_operations cluster_operation) @ [
 
-       field   ~qualifier:StaticRO ~lifecycle
+        field   ~qualifier:StaticRO ~lifecycle
           ~ty:Bool "pool_auto_join" ~default_value:(Some (VBool true))
-          "True if xapi is automatically joining new pool members to the cluster. This will be `true` in the first release"
+          "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
@@ -143,6 +196,7 @@ let t =
     ~messages:
       [ create
       ; destroy
+      ; get_network
       ; pool_create
       ; pool_force_destroy
       ; pool_destroy

ocaml/idl/datamodel_cluster_host.ml

@@ -20,6 +20,7 @@ let create = call
     ~params:
       [ Ref _cluster, "cluster", "Cluster to join"
       ; Ref _host,    "host",    "new cluster member"
+      ; Ref _pif,     "pif",     "Network interface to use for communication"
       ]
     ~lifecycle
     ~allowed_roles:_R_POOL_ADMIN
@@ -65,6 +66,17 @@ let disable = call
     ~allowed_roles:_R_POOL_ADMIN
     ()
 
+let forget = call
+  ~name:"forget"
+  ~doc:"Permanently remove a dead host from the cluster. This host must never rejoin the cluster."
+  ~params:
+      [ Ref _cluster_host, "self", "the cluster_host to declare permanently dead and forget"
+      ]
+  ~lifecycle:[Prototyped, rel_lima, ""]
+  ~allowed_roles:_R_LOCAL_ROOT_ONLY
+  ~hide_from_docs:true
+  ()
+
 let t =
   create_obj
     ~name: _cluster_host
@@ -92,12 +104,20 @@ let t =
           ~ty:Bool "enabled" ~default_value:(Some (VBool false))
           "Whether the cluster host believes that clustering should be enabled on this host"
 
+      ; field  ~qualifier:StaticRO ~lifecycle
+          ~ty:(Ref _pif) "PIF" ~default_value:(Some (VRef null_ref))
+          "Reference to the PIF object"
+
+      ; field  ~qualifier:StaticRO ~lifecycle
+          ~ty:Bool "joined" ~default_value:(Some (VBool true))
+          "Whether the cluster host has joined the cluster"
+
       (* TODO: add `live` member to represent whether corosync believes that this
                cluster host actually is enabled *)
-      
+
       ] @ (allowed_and_current_operations cluster_host_operation) @ [
 
-       field   ~qualifier:StaticRO ~lifecycle
+        field   ~qualifier:StaticRO ~lifecycle
           ~ty:(Map(String, String)) "other_config" ~default_value:(Some (VMap []))
           "Additional configuration"
       ])
@@ -106,6 +126,7 @@ let t =
       ; destroy
       ; enable
       ; force_destroy
+      ; forget
       ; disable
       ]
     ()

ocaml/idl/datamodel_common.ml

@@ -4,10 +4,11 @@ open Datamodel_types
 open Datamodel_roles
 
 (* IMPORTANT: Please bump schema vsn if you change/add/remove a _field_.
-              You do not have to bump vsn if you change/add/remove a message *)
-
+              You do not have to bump vsn if you change/add/remove a message
+              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 = 142
+let schema_minor_vsn = 202
 
 (* Historical schema versions just in case this is useful later *)
 let rio_schema_major_vsn = 5
@@ -189,6 +190,12 @@ let get_product_releases in_product_since =
     | x::xs -> go_through_release_order xs
   in go_through_release_order release_order
 
+let lima_release =
+  { internal = get_product_releases rel_lima
+  ; opensource = get_oss_releases None
+  ; internal_deprecated_since = None
+  }
+
 let kolkata_release =
   { internal = get_product_releases rel_kolkata
   ; opensource = get_oss_releases None

ocaml/idl/datamodel_errors.ml

@@ -1134,12 +1134,18 @@ let _ =
     ~doc:"The host does not have a Cluster_host with a compatible cluster stack." ();
   error Api_errors.cluster_force_destroy_failed ["cluster"]
     ~doc:"Force destroy failed on a Cluster_host while force destroying the cluster." ();
-  error Api_errors.clustering_enabled_on_network ["network"]
-    ~doc:"The network has cluster objects attached." ();
   error Api_errors.cluster_stack_in_use ["cluster_stack"]
     ~doc:"The cluster stack is already in use." ();
   error Api_errors.invalid_cluster_stack [ "cluster_stack" ]
-    ~doc:"The cluster stack provided is not supported." ()
+    ~doc:"The cluster stack provided is not supported." ();
+  error Api_errors.pif_not_attached_to_host [ "pif"; "host" ]
+    ~doc:"Cluster_host creation failed as the PIF provided is not attached to the host." ();
+  error Api_errors.cluster_host_not_joined [ "cluster_host" ]
+    ~doc:"Cluster_host operation failed as the cluster_host has not joined the cluster." ();
+  error Api_errors.cluster_host_is_last ["cluster_host"]
+    ~doc:"The last cluster host cannot be destroyed. Destroy the cluster instead" ()
+
+
 
 let _ =
   message (fst Api_messages.ha_pool_overcommitted) ~doc:"Pool has become overcommitted: it can no longer guarantee to restart protected VMs if the configured number of hosts fail." ();

ocaml/idl/datamodel_types.ml

@@ -59,6 +59,7 @@ let rel_honolulu = "honolulu"
 let rel_inverness = "inverness"
 let rel_jura = "jura"
 let rel_kolkata = "kolkata"
+let rel_lima = "lima"
 
 type api_release = {
   code_name: string option;
@@ -204,6 +205,11 @@ let release_order_full = [{
      version_major = 2;
      version_minor = 10;
      branding   = "XenServer 7.5";
+   }; {
+     code_name     = Some rel_lima;
+     version_major = 2;
+     version_minor = 11;
+     branding   = "Unreleased";
    };
   ]
 (* When you add a new release, use the version number of the latest release,

ocaml/quicktest/quicktest.ml

@@ -21,7 +21,6 @@ let () =
   let suite =
     [ "Quicktest_example", Quicktest_example.tests s
     ; "cbt", Quicktest_cbt.tests s
-    ; "reconfigure-ip-cluster", Quicktest_cluster.tests s
     ; "event", Quicktest_event.tests s
     ; "import_raw_vdi", Quicktest_import_raw_vdi.tests s
     ; "copy", Quicktest_vdi_copy.tests s