From fe5bd93ffbf377fddab08ff0e3e1da98671c44d4 Mon Sep 17 00:00:00 2001 From: Rob Hoes Date: Mon, 15 Aug 2016 16:57:03 +0100 Subject: [PATCH 1/3] Reorganise and document pool_features.ml This makes it a little easier to understand. There are no functional changes. Signed-off-by: Rob Hoes --- ocaml/xapi/pool_features.ml | 102 +++++++++++++++++++++++------------- 1 file changed, 67 insertions(+), 35 deletions(-) diff --git a/ocaml/xapi/pool_features.ml b/ocaml/xapi/pool_features.ml index badab68a2d..db0722dfd7 100644 --- a/ocaml/xapi/pool_features.ml +++ b/ocaml/xapi/pool_features.ml @@ -15,17 +15,17 @@ open Features module D = Debug.Make(struct let name="pool_features" end) open D -let all_flags = List.map (fun (k, v) -> k) (to_assoc_list all_features) - -let new_restrictions params = - let kvs = List.filter (fun (k, v) -> - try String.sub k 0 9 = "restrict_" && not (List.mem k all_flags) - with Invalid_argument _ -> false - ) params in - List.map (fun (k, v) -> k) kvs +(* + Terminology: + - (Feature) flags: The keys in pool.restriction and host.license_params. Strings like "restrict_dmc". + - Params: An instance of host.license_params. + - Restrictions: A (string * string) list of feature flag to a Boolean string value ("true" or "false"). + - Features: Values of type Features.feature. + - Core: Relating to features known by xapi, as define in features.ml. + - Additional: Relating to features provided by v6d beyond the core ones. +*) -let pool_features_of_list hosts = - List.fold_left Stdext.Listext.List.intersect all_features hosts +let all_flags = List.map (fun (k, v) -> k) (to_assoc_list all_features) let get_pool_features ~__context = let pool = Helpers.get_pool ~__context in @@ -37,39 +37,71 @@ let is_enabled ~__context f = let assert_enabled ~__context ~f = if not (is_enabled ~__context f) then - raise (Api_errors.Server_error(Api_errors.license_restriction, [Features.name_of_feature f])) + raise (Api_errors.Server_error(Api_errors.license_restriction, [name_of_feature f])) + +(* The set of core restrictions of a pool is the intersection of the sets of features + of the individual hosts. *) +let compute_core_features all_host_params = + List.map of_assoc_list all_host_params + |> List.fold_left Stdext.Listext.List.intersect all_features +(* Find the feature flags in the given license params that are not represented + in the feature type. These are additional flags given to us by v6d. + Assume that their names always start with "restrict_". *) +let find_additional_flags params = + let kvs = List.filter (fun (k, v) -> + try String.sub k 0 9 = "restrict_" && not (List.mem k all_flags) + with Invalid_argument _ -> false + ) params in + List.map fst kvs + +(* Determine the set of additional features. For each restrict_ flag, + looks for matching flags on all hosts; if one of them is restricted ("true") + or absent, then the feature on the pool level is marked as restricted. *) +let rec compute_additional_restrictions all_host_params = function + | [] -> [] + | flag :: rest -> + let switches = + List.map + (function params -> + if List.mem_assoc flag params + then bool_of_string (List.assoc flag params) + else true) + all_host_params + in + (flag, string_of_bool (List.fold_left (||) false switches)) :: + compute_additional_restrictions all_host_params rest + +(* Combine the host-level feature restrictions into pool-level ones, and write + the result to the database. *) let update_pool_features ~__context = + (* Get information from the database *) let pool = Helpers.get_pool ~__context in - let pool_restrictions = Db.Pool.get_restrictions ~__context ~self:pool in - let hosts = List.map + let old_restrictions = Db.Pool.get_restrictions ~__context ~self:pool in + let all_host_params = List.map (fun (_, host_r) -> host_r.API.host_license_params) (Db.Host.get_all_records ~__context) in - let master = + let master_params = let master_ref = Db.Pool.get_master ~__context ~self:pool in Db.Host.get_license_params ~__context ~self:master_ref in - let new_features = pool_features_of_list (List.map of_assoc_list hosts) in - let additional_flags = new_restrictions master in - let rec find_additional = function - | [] -> [] - | flag :: rest -> - let switches = - List.map - (function params -> - if List.mem_assoc flag params - then bool_of_string (List.assoc flag params) - else true) - hosts - in - (flag, string_of_bool (List.fold_left (||) false switches)) :: find_additional rest - in - let additional_restrictions = find_additional additional_flags in - let new_restrictions = additional_restrictions @ (to_assoc_list new_features) in - if new_restrictions <> pool_restrictions then begin - let pool_features = of_assoc_list pool_restrictions in - info "Old pool features enabled: %s" (to_compact_string pool_features); - info "New pool features enabled: %s" (to_compact_string new_features); + + (* Determine the set of core restrictions *) + let new_core_features = compute_core_features all_host_params in + let new_core_restrictions = to_assoc_list new_core_features in + + (* Determine the set of additional restrictions *) + let additional_flags = find_additional_flags master_params in + let new_additional_restrictions = compute_additional_restrictions all_host_params additional_flags in + + (* The complete set of restrictions is formed by the core feature plus the additional features *) + let new_restrictions = new_additional_restrictions @ new_core_restrictions in + + (* Update the DB if the restrictions have changed *) + if new_restrictions <> old_restrictions then begin + let old_core_features = of_assoc_list old_restrictions in + info "Old pool features enabled: %s" (to_compact_string old_core_features); + info "New pool features enabled: %s" (to_compact_string new_core_features); Db.Pool.set_restrictions ~__context ~self:pool ~value:new_restrictions; Xapi_pool_helpers.apply_guest_agent_config ~__context end From a1ada41956e492a751ff57a22bd6d15c37bab6a9 Mon Sep 17 00:00:00 2001 From: Rob Hoes Date: Tue, 16 Aug 2016 16:13:41 +0100 Subject: [PATCH 2/3] CA-212079: Allow XenMotion and AD during RPU from pre-Dundee The XenMotion and AD feature recently had restrictions put in place, so that they can be switched on and off by feature flags. A feature is considered to be enabled only if all hosts in the pool have it enabled. During a rolling pool upgrade (RPU) from a pool that does not have the new feature flags, the absence of the flags was treated as a feature restriction, such that the pool as a whole had XenMotion and AD restricted. Luckily the restrictions were only enforced on hosts that were already upgraded, so that VMs could still migrate off hosts that still need to be upgraded. This patch introduces a list of features (currently just XenMotion and AD) that are considered to be enabled if the feature flag is absent, to avoid the issues described above. Signed-off-by: Rob Hoes --- ocaml/xapi/features.ml | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/ocaml/xapi/features.ml b/ocaml/xapi/features.ml index 44092d9aa9..441df767e0 100644 --- a/ocaml/xapi/features.ml +++ b/ocaml/xapi/features.ml @@ -95,6 +95,12 @@ let keys_of_features = Live_patching, ("restrict_live_patching", Negative, "Live_patching"); ] +(* A list of features that must be considered "enabled" by `of_assoc_list` + if the feature string is missing from the list. These are existing features + that have been recently restricted, and which we want to remain enabled during + a rolling pool upgrade. *) +let enabled_when_unknown = [Xen_motion; AD] + let name_of_feature f = rpc_of_feature f |> Rpc.string_of_rpc @@ -134,15 +140,13 @@ let to_assoc_list (s: feature list) = List.map get_map all_features let of_assoc_list l = - let get_feature (k, v) = + let get_feature f = try - let v = bool_of_string v in - let f, o = feature_of_string k in + let str, o = string_of_feature f in + let v = bool_of_string (List.assoc str l) in let v = if o = Positive then v else not v in if v then Some f else None with _ -> - None + if List.mem f enabled_when_unknown then Some f else None in - let features = List.map get_feature l in - List.fold_left (function ac -> function Some f -> f :: ac | None -> ac) [] features - + Stdext.Listext.List.filter_map get_feature all_features From 071e6441ba5ba997beb4c27018ef25d521ce0176 Mon Sep 17 00:00:00 2001 From: Rob Hoes Date: Tue, 16 Aug 2016 22:21:40 +0100 Subject: [PATCH 3/3] Unit tests for Features.of_assoc_list Signed-off-by: Rob Hoes --- ocaml/test/OMakefile | 1 + ocaml/test/suite.ml | 1 + ocaml/test/test_features.ml | 67 +++++++++++++++++++++++++++++++++++++ 3 files changed, 69 insertions(+) create mode 100644 ocaml/test/test_features.ml diff --git a/ocaml/test/OMakefile b/ocaml/test/OMakefile index 777c996755..a7572a1c5d 100644 --- a/ocaml/test/OMakefile +++ b/ocaml/test/OMakefile @@ -64,6 +64,7 @@ OCAML_OBJS = \ test_dbsync_master \ test_xapi_xenops \ test_no_migrate \ + test_features \ OCamlProgram(suite, suite $(OCAML_OBJS) ) diff --git a/ocaml/test/suite.ml b/ocaml/test/suite.ml index 8b1fcb6aa1..4cd66b0108 100644 --- a/ocaml/test/suite.ml +++ b/ocaml/test/suite.ml @@ -34,6 +34,7 @@ let base_suite = Test_map_check.test; Test_pool_apply_edition.test; Test_pool_license.test; + Test_features.test; Test_pool_restore_database.test; Test_platformdata.test; Test_sm_features.test; diff --git a/ocaml/test/test_features.ml b/ocaml/test/test_features.ml new file mode 100644 index 0000000000..f2719773c2 --- /dev/null +++ b/ocaml/test/test_features.ml @@ -0,0 +1,67 @@ +(* + * Copyright (C) Citrix Systems Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + *) + +open OUnit +open Test_highlevel +open Features + +module OfAssocList = Generic.Make(struct + module Io = struct + type input_t = (string * string) list + type output_t = Features.feature list + + let string_of_input_t = Test_printers.(assoc_list string string) + let string_of_output_t = + Test_printers.(fun features -> String.concat "," (List.map name_of_feature features)) + end + + let transform = of_assoc_list + + (* Xen_motion and AD are enabled unless explicitly disabled. All other features + are disabled unless explitly enabled. *) + let tests = [ + [], + [Xen_motion; AD]; + + ["restrict_xen_motion", "true"; + "restrict_ad", "true"], + []; + + ["restrict_xen_motion", "true"], + [AD]; + + ["restrict_xen_motion", "false"], + [Xen_motion; AD]; + + ["restrict_xen_motion", "false"; + "restrict_dmc", "false"], + [DMC; Xen_motion; AD]; + + ["restrict_xen_motion", "false"; + "restrict_ad", "true"; + "restrict_dmc", "false"], + [DMC; Xen_motion]; + + ["enable_xha", "true"; + "restrict_xen_motion", "true"], + [HA; AD]; + ] +end) + + +let test = + "pool_license" >::: + [ + "test_of_assoc_list" >::: OfAssocList.tests; + ]