Skip to content

Commit 745c932

Browse files
robhoesrobhoes
authored
Merge pull request #2732 from robhoes/ca212079
CA-212079: Allow XenMotion and AD during RPU from pre-Dundee
2 parents 0c450b7 + 071e644 commit 745c932

File tree

5 files changed

+147
-42
lines changed

5 files changed

+147
-42
lines changed

‎ocaml/test/OMakefile‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -64,6 +64,7 @@ OCAML_OBJS = \
6464
test_dbsync_master \
6565
test_xapi_xenops \
6666
test_no_migrate \
67+
test_features \
6768

6869
OCamlProgram(suite, suite $(OCAML_OBJS) )
6970

‎ocaml/test/suite.ml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,7 @@ let base_suite =
3434
Test_map_check.test;
3535
Test_pool_apply_edition.test;
3636
Test_pool_license.test;
37+
Test_features.test;
3738
Test_pool_restore_database.test;
3839
Test_platformdata.test;
3940
Test_sm_features.test;

‎ocaml/test/test_features.ml‎

Lines changed: 67 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,67 @@
1+
(*
2+
* Copyright (C) Citrix Systems Inc.
3+
*
4+
* This program is free software; you can redistribute it and/or modify
5+
* it under the terms of the GNU Lesser General Public License as published
6+
* by the Free Software Foundation; version 2.1 only. with the special
7+
* exception on linking described in file LICENSE.
8+
*
9+
* This program is distributed in the hope that it will be useful,
10+
* but WITHOUT ANY WARRANTY; without even the implied warranty of
11+
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12+
* GNU Lesser General Public License for more details.
13+
*)
14+
15+
open OUnit
16+
open Test_highlevel
17+
open Features
18+
19+
module OfAssocList = Generic.Make(struct
20+
module Io = struct
21+
type input_t = (string * string) list
22+
type output_t = Features.feature list
23+
24+
let string_of_input_t = Test_printers.(assoc_list string string)
25+
let string_of_output_t =
26+
Test_printers.(fun features -> String.concat "," (List.map name_of_feature features))
27+
end
28+
29+
let transform = of_assoc_list
30+
31+
(* Xen_motion and AD are enabled unless explicitly disabled. All other features
32+
are disabled unless explitly enabled. *)
33+
let tests = [
34+
[],
35+
[Xen_motion; AD];
36+
37+
["restrict_xen_motion", "true";
38+
"restrict_ad", "true"],
39+
[];
40+
41+
["restrict_xen_motion", "true"],
42+
[AD];
43+
44+
["restrict_xen_motion", "false"],
45+
[Xen_motion; AD];
46+
47+
["restrict_xen_motion", "false";
48+
"restrict_dmc", "false"],
49+
[DMC; Xen_motion; AD];
50+
51+
["restrict_xen_motion", "false";
52+
"restrict_ad", "true";
53+
"restrict_dmc", "false"],
54+
[DMC; Xen_motion];
55+
56+
["enable_xha", "true";
57+
"restrict_xen_motion", "true"],
58+
[HA; AD];
59+
]
60+
end)
61+
62+
63+
let test =
64+
"pool_license" >:::
65+
[
66+
"test_of_assoc_list" >::: OfAssocList.tests;
67+
]

‎ocaml/xapi/features.ml‎

Lines changed: 11 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -95,6 +95,12 @@ let keys_of_features =
9595
Live_patching, ("restrict_live_patching", Negative, "Live_patching");
9696
]
9797

98+
(* A list of features that must be considered "enabled" by `of_assoc_list`
99+
if the feature string is missing from the list. These are existing features
100+
that have been recently restricted, and which we want to remain enabled during
101+
a rolling pool upgrade. *)
102+
let enabled_when_unknown = [Xen_motion; AD]
103+
98104
let name_of_feature f =
99105
rpc_of_feature f |> Rpc.string_of_rpc
100106

@@ -134,15 +140,13 @@ let to_assoc_list (s: feature list) =
134140
List.map get_map all_features
135141

136142
let of_assoc_list l =
137-
let get_feature (k, v) =
143+
let get_feature f =
138144
try
139-
let v = bool_of_string v in
140-
let f, o = feature_of_string k in
145+
let str, o = string_of_feature f in
146+
let v = bool_of_string (List.assoc str l) in
141147
let v = if o = Positive then v else not v in
142148
if v then Some f else None
143149
with _ ->
144-
None
150+
if List.mem f enabled_when_unknown then Some f else None
145151
in
146-
let features = List.map get_feature l in
147-
List.fold_left (function ac -> function Some f -> f :: ac | None -> ac) [] features
148-
152+
Stdext.Listext.List.filter_map get_feature all_features

‎ocaml/xapi/pool_features.ml‎

Lines changed: 67 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -15,17 +15,17 @@ open Features
1515
module D = Debug.Make(struct let name="pool_features" end)
1616
open D
1717

18-
let all_flags = List.map (fun (k, v) -> k) (to_assoc_list all_features)
19-
20-
let new_restrictions params =
21-
let kvs = List.filter (fun (k, v) ->
22-
try String.sub k 0 9 = "restrict_" && not (List.mem k all_flags)
23-
with Invalid_argument _ -> false
24-
) params in
25-
List.map (fun (k, v) -> k) kvs
18+
(*
19+
Terminology:
20+
- (Feature) flags: The keys in pool.restriction and host.license_params. Strings like "restrict_dmc".
21+
- Params: An instance of host.license_params.
22+
- Restrictions: A (string * string) list of feature flag to a Boolean string value ("true" or "false").
23+
- Features: Values of type Features.feature.
24+
- Core: Relating to features known by xapi, as define in features.ml.
25+
- Additional: Relating to features provided by v6d beyond the core ones.
26+
*)
2627

27-
let pool_features_of_list hosts =
28-
List.fold_left Stdext.Listext.List.intersect all_features hosts
28+
let all_flags = List.map (fun (k, v) -> k) (to_assoc_list all_features)
2929

3030
let get_pool_features ~__context =
3131
let pool = Helpers.get_pool ~__context in
@@ -37,39 +37,71 @@ let is_enabled ~__context f =
3737

3838
let assert_enabled ~__context ~f =
3939
if not (is_enabled ~__context f) then
40-
raise (Api_errors.Server_error(Api_errors.license_restriction, [Features.name_of_feature f]))
40+
raise (Api_errors.Server_error(Api_errors.license_restriction, [name_of_feature f]))
41+
42+
(* The set of core restrictions of a pool is the intersection of the sets of features
43+
of the individual hosts. *)
44+
let compute_core_features all_host_params =
45+
List.map of_assoc_list all_host_params
46+
|> List.fold_left Stdext.Listext.List.intersect all_features
4147

48+
(* Find the feature flags in the given license params that are not represented
49+
in the feature type. These are additional flags given to us by v6d.
50+
Assume that their names always start with "restrict_". *)
51+
let find_additional_flags params =
52+
let kvs = List.filter (fun (k, v) ->
53+
try String.sub k 0 9 = "restrict_" && not (List.mem k all_flags)
54+
with Invalid_argument _ -> false
55+
) params in
56+
List.map fst kvs
57+
58+
(* Determine the set of additional features. For each restrict_ flag,
59+
looks for matching flags on all hosts; if one of them is restricted ("true")
60+
or absent, then the feature on the pool level is marked as restricted. *)
61+
let rec compute_additional_restrictions all_host_params = function
62+
| [] -> []
63+
| flag :: rest ->
64+
let switches =
65+
List.map
66+
(function params ->
67+
if List.mem_assoc flag params
68+
then bool_of_string (List.assoc flag params)
69+
else true)
70+
all_host_params
71+
in
72+
(flag, string_of_bool (List.fold_left (||) false switches)) ::
73+
compute_additional_restrictions all_host_params rest
74+
75+
(* Combine the host-level feature restrictions into pool-level ones, and write
76+
the result to the database. *)
4277
let update_pool_features ~__context =
78+
(* Get information from the database *)
4379
let pool = Helpers.get_pool ~__context in
44-
let pool_restrictions = Db.Pool.get_restrictions ~__context ~self:pool in
45-
let hosts = List.map
80+
let old_restrictions = Db.Pool.get_restrictions ~__context ~self:pool in
81+
let all_host_params = List.map
4682
(fun (_, host_r) -> host_r.API.host_license_params)
4783
(Db.Host.get_all_records ~__context) in
48-
let master =
84+
let master_params =
4985
let master_ref = Db.Pool.get_master ~__context ~self:pool in
5086
Db.Host.get_license_params ~__context ~self:master_ref
5187
in
52-
let new_features = pool_features_of_list (List.map of_assoc_list hosts) in
53-
let additional_flags = new_restrictions master in
54-
let rec find_additional = function
55-
| [] -> []
56-
| flag :: rest ->
57-
let switches =
58-
List.map
59-
(function params ->
60-
if List.mem_assoc flag params
61-
then bool_of_string (List.assoc flag params)
62-
else true)
63-
hosts
64-
in
65-
(flag, string_of_bool (List.fold_left (||) false switches)) :: find_additional rest
66-
in
67-
let additional_restrictions = find_additional additional_flags in
68-
let new_restrictions = additional_restrictions @ (to_assoc_list new_features) in
69-
if new_restrictions <> pool_restrictions then begin
70-
let pool_features = of_assoc_list pool_restrictions in
71-
info "Old pool features enabled: %s" (to_compact_string pool_features);
72-
info "New pool features enabled: %s" (to_compact_string new_features);
88+
89+
(* Determine the set of core restrictions *)
90+
let new_core_features = compute_core_features all_host_params in
91+
let new_core_restrictions = to_assoc_list new_core_features in
92+
93+
(* Determine the set of additional restrictions *)
94+
let additional_flags = find_additional_flags master_params in
95+
let new_additional_restrictions = compute_additional_restrictions all_host_params additional_flags in
96+
97+
(* The complete set of restrictions is formed by the core feature plus the additional features *)
98+
let new_restrictions = new_additional_restrictions @ new_core_restrictions in
99+
100+
(* Update the DB if the restrictions have changed *)
101+
if new_restrictions <> old_restrictions then begin
102+
let old_core_features = of_assoc_list old_restrictions in
103+
info "Old pool features enabled: %s" (to_compact_string old_core_features);
104+
info "New pool features enabled: %s" (to_compact_string new_core_features);
73105
Db.Pool.set_restrictions ~__context ~self:pool ~value:new_restrictions;
74106
Xapi_pool_helpers.apply_guest_agent_config ~__context
75107
end

0 commit comments

Comments
 (0)