From 910b04d11af0326d035df91c2f1c9b27f252b85e Mon Sep 17 00:00:00 2001 From: Rob Hoes Date: Thu, 17 Aug 2023 16:55:51 +0000 Subject: [PATCH 1/5] CA-381133: Set pending_guidances based on recommended guidance After applying updates, the `recommended_guidances` field is set to the "recommended guidance" from the applied metadata from the applied updates. Any EvacuateHost guidance, which is meant to be followed before applying updates, is excluded from the list. Xapi uses this field to just what to do when the client calls `host.apply_recommended_guidance`. This has not changed. The `pending_guidances` field used to be set based on the "absolute guidance" of the update metadata. However, this turned out to be the wrong choice to guide clients on what to do after applying updates. The field also contained guidance to reboot the host in case a live-patch failed to apply. This is not included in the `recommended_guidance` as it is not meant to be actioned on in `host.apply_recommended_guidance`. Now, `pending_guidances` is set to the same value as `recommended_guidances`, plus the reboot guidance in case of a failed live-patch. The above applies to the guidance fields of both the `host` and `VM` classes. Signed-off-by: Rob Hoes (cherry picked from commit 0c9d54992c7a866a79ca634025a9d92823acb31a) --- ocaml/xapi/repository.ml | 23 ++++++----------------- 1 file changed, 6 insertions(+), 17 deletions(-) diff --git a/ocaml/xapi/repository.ml b/ocaml/xapi/repository.ml index 224112aed90..ebb94127e4f 100644 --- a/ocaml/xapi/repository.ml +++ b/ocaml/xapi/repository.ml @@ -747,40 +747,29 @@ let apply_updates' ~__context ~host ~updates_info ~livepatches ~acc_rpm_updates ) ; (* Evaluate recommended/pending guidances *) let recommended_guidances, pending_guidances = - let new_recommended_gs = + let guidances = (* EvacuateHost will be applied before applying updates *) eval_guidances ~updates_info ~updates:acc_rpm_updates ~kind:Recommended ~livepatches:successful_livepatches ~failed_livepatches |> List.filter (fun g -> g <> Guidance.EvacuateHost) in - let recommended_guidances' = + let guidances' = merge_with_unapplied_guidances ~__context ~host ~kind:Recommended - ~guidances:new_recommended_gs + ~guidances in - - let new_pending_gs = - eval_guidances ~updates_info ~updates:acc_rpm_updates ~kind:Absolute - ~livepatches:[] ~failed_livepatches:[] - |> List.filter (fun g -> not (List.mem g recommended_guidances')) - in - let pending_guidances' = - merge_with_unapplied_guidances ~__context ~host ~kind:Absolute - ~guidances:new_pending_gs - in - match failed_livepatches with | [] -> (* No livepatch should be applicable now *) Db.Host.remove_pending_guidances ~__context ~self:host ~value:`reboot_host_on_livepatch_failure ; - (recommended_guidances', pending_guidances') + (guidances', guidances') | _ :: _ -> (* There is(are) livepatch failure(s): * the host should not be rebooted, and * an extra pending guidance 'RebootHostOnLivePatchFailure' should be set. *) - ( List.filter (fun g -> g <> Guidance.RebootHost) recommended_guidances' - , Guidance.RebootHostOnLivePatchFailure :: pending_guidances' + ( List.filter (fun g -> g <> Guidance.RebootHost) guidances' + , Guidance.RebootHostOnLivePatchFailure :: guidances' ) in List.iter From 630b8660efc643cf33c0f2f7a95c0b780a68dfbf Mon Sep 17 00:00:00 2001 From: Rob Hoes Date: Thu, 17 Aug 2023 17:18:36 +0000 Subject: [PATCH 2/5] CA-381133: Make {host;VM}.recommended_guidances internal-only These fields are used internally by xapi and not meant for clients. Signed-off-by: Rob Hoes (cherry picked from commit 42b0195a229b40efa710d445d76691f5992a04dc) --- ocaml/idl/datamodel_common.ml | 2 +- ocaml/idl/datamodel_host.ml | 5 +++-- ocaml/idl/datamodel_vm.ml | 5 +++-- ocaml/idl/schematest.ml | 2 +- ocaml/xapi-cli-server/records.ml | 12 ------------ 5 files changed, 8 insertions(+), 18 deletions(-) diff --git a/ocaml/idl/datamodel_common.ml b/ocaml/idl/datamodel_common.ml index 35d140dfffe..b828331e712 100644 --- a/ocaml/idl/datamodel_common.ml +++ b/ocaml/idl/datamodel_common.ml @@ -10,7 +10,7 @@ open Datamodel_roles to leave a gap for potential hotfixes needing to increment the schema version.*) let schema_major_vsn = 5 -let schema_minor_vsn = 764 +let schema_minor_vsn = 765 (* Historical schema versions just in case this is useful later *) let rio_schema_major_vsn = 5 diff --git a/ocaml/idl/datamodel_host.ml b/ocaml/idl/datamodel_host.ml index 7abcc19f200..a97873766c0 100644 --- a/ocaml/idl/datamodel_host.ml +++ b/ocaml/idl/datamodel_host.ml @@ -2135,8 +2135,9 @@ let t = ; field ~qualifier:DynamicRO ~lifecycle:[] ~ty:Bool ~default_value:(Some (VBool false)) "https_only" "Reflects whether port 80 is open (false) or not (true)" - ; field ~qualifier:DynamicRO ~lifecycle:[] ~ty:(Set update_guidances) - "recommended_guidances" ~default_value:(Some (VSet [])) + ; field ~qualifier:DynamicRO ~internal_only:true ~lifecycle:[] + ~ty:(Set update_guidances) "recommended_guidances" + ~default_value:(Some (VSet [])) "The set of recommended guidances after applying updates" ; field ~qualifier:DynamicRO ~lifecycle:[] ~ty:latest_synced_updates_applied_state diff --git a/ocaml/idl/datamodel_vm.ml b/ocaml/idl/datamodel_vm.ml index 99e5f135132..3b673ae4538 100644 --- a/ocaml/idl/datamodel_vm.ml +++ b/ocaml/idl/datamodel_vm.ml @@ -2141,8 +2141,9 @@ let t = ~ty:(Set update_guidances) "pending_guidances" ~default_value:(Some (VSet [])) "The set of pending guidances after applying updates" - ; field ~qualifier:DynamicRO ~lifecycle:[] ~ty:(Set update_guidances) - "recommended_guidances" ~default_value:(Some (VSet [])) + ; field ~qualifier:DynamicRO ~internal_only:true ~lifecycle:[] + ~ty:(Set update_guidances) "recommended_guidances" + ~default_value:(Some (VSet [])) "The set of recommended guidances after applying updates" ] ) diff --git a/ocaml/idl/schematest.ml b/ocaml/idl/schematest.ml index a93705b080f..db8515531db 100644 --- a/ocaml/idl/schematest.ml +++ b/ocaml/idl/schematest.ml @@ -2,7 +2,7 @@ let hash x = Digest.string x |> Digest.to_hex (* BEWARE: if this changes, check that schema has been bumped accordingly in ocaml/idl/datamodel_common.ml, usually schema_minor_vsn *) -let last_known_schema_hash = "3efd34e77e3d098653f4f0e1c89bae1d" +let last_known_schema_hash = "4afbb7a630383c292bc88394f0b3f0d8" let current_schema_hash : string = let open Datamodel_types in diff --git a/ocaml/xapi-cli-server/records.ml b/ocaml/xapi-cli-server/records.ml index bb22ae3b0fd..c3d350b7cf2 100644 --- a/ocaml/xapi-cli-server/records.ml +++ b/ocaml/xapi-cli-server/records.ml @@ -2588,12 +2588,6 @@ let vm_record rpc session_id vm = ; make_field ~name:"vtpms" ~get:(fun () -> get_uuids_from_refs (x ()).API.vM_VTPMs) () - ; make_field ~name:"recommended-guidances" - ~get:(fun () -> - map_and_concat Record_util.update_guidance_to_string - (x ()).API.vM_recommended_guidances - ) - () ] } @@ -3232,12 +3226,6 @@ let host_record rpc session_id host = ; make_field ~name:"last-software-update" ~get:(fun () -> Date.to_string (x ()).API.host_last_software_update) () - ; make_field ~name:"recommended-guidances" - ~get:(fun () -> - map_and_concat Record_util.update_guidance_to_string - (x ()).API.host_recommended_guidances - ) - () ; make_field ~name:"latest-synced-updates-applied" ~get:(fun () -> Record_util.latest_synced_updates_applied_state_to_string From b681fbf5cb12358ea488cb2394d32cc90cde2a92 Mon Sep 17 00:00:00 2001 From: Ming Lu Date: Fri, 18 Aug 2023 11:18:25 +0800 Subject: [PATCH 3/5] CA-381133: Remove usage of host|VM.recommended_guidances Signed-off-by: Ming Lu (cherry picked from commit aa9416c70a83e2d94bfbdad70b078fe8ab8c12f5) --- ocaml/xapi/repository.ml | 77 +++++++++++--------------------- ocaml/xapi/repository_helpers.ml | 12 ++--- ocaml/xapi/xapi_host.ml | 22 ++++----- ocaml/xapi/xapi_host_helpers.ml | 4 -- 4 files changed, 42 insertions(+), 73 deletions(-) diff --git a/ocaml/xapi/repository.ml b/ocaml/xapi/repository.ml index ebb94127e4f..18104010ae4 100644 --- a/ocaml/xapi/repository.ml +++ b/ocaml/xapi/repository.ml @@ -632,61 +632,46 @@ let apply_livepatch ~__context ~host:_ ~component ~base_build_id ~base_version error "%s" msg ; raise Api_errors.(Server_error (internal_error, [msg])) -let set_restart_device_models ~__context ~host ~kind = +let set_restart_device_models ~__context ~host = (* Set pending restart device models of all running HVM VMs on the host *) do_with_device_models ~__context ~host @@ fun (ref, record) -> match (record.API.vM_power_state, Helpers.has_qemu_currently ~__context ~self:ref) with - | `Running, true | `Paused, true -> ( - match kind with - | Guidance.Absolute -> - Db.VM.set_pending_guidances ~__context ~self:ref - ~value:[`restart_device_model] ; - None - | Guidance.Recommended -> - Db.VM.set_recommended_guidances ~__context ~self:ref - ~value:[`restart_device_model] ; - None - ) + | `Running, true | `Paused, true -> + Db.VM.set_pending_guidances ~__context ~self:ref + ~value:[`restart_device_model] ; + None | _ -> (* No device models are running for this VM *) None -let set_guidances ~__context ~host ~guidances ~db_set ~kind = +let set_guidances ~__context ~host ~guidances ~db_set = let open Guidance in guidances |> List.fold_left (fun acc g -> - match (g, kind) with - | RebootHost, _ -> + match g with + | RebootHost -> `reboot_host :: acc - | RestartToolstack, _ -> + | RestartToolstack -> `restart_toolstack :: acc - | RestartDeviceModel, _ -> - set_restart_device_models ~__context ~host ~kind ; + | RestartDeviceModel -> + set_restart_device_models ~__context ~host ; acc - | RebootHostOnLivePatchFailure, Absolute -> + | RebootHostOnLivePatchFailure -> `reboot_host_on_livepatch_failure :: acc - | _, Absolute -> + | _ -> warn "Unsupported pending guidance %s, ignoring it." (Guidance.to_string g) ; acc - | _, Recommended -> - warn "Unsupported recommended guidance %s, ignoring it." - (Guidance.to_string g) ; - acc ) [] |> fun gs -> db_set ~__context ~self:host ~value:gs let set_pending_guidances ~__context ~host ~guidances = set_guidances ~__context ~host ~guidances - ~db_set:Db.Host.set_pending_guidances ~kind:Absolute - -let set_recommended_guidances ~__context ~host ~guidances = - set_guidances ~__context ~host ~guidances - ~db_set:Db.Host.set_recommended_guidances ~kind:Recommended + ~db_set:Db.Host.set_pending_guidances let apply_livepatches' ~__context ~host ~livepatches = List.partition_map @@ -745,43 +730,33 @@ let apply_updates' ~__context ~host ~updates_info ~livepatches ~acc_rpm_updates ) ] ) ; - (* Evaluate recommended/pending guidances *) - let recommended_guidances, pending_guidances = - let guidances = + (* Evaluate guidances *) + let guidances = + let guidances' = (* EvacuateHost will be applied before applying updates *) eval_guidances ~updates_info ~updates:acc_rpm_updates ~kind:Recommended ~livepatches:successful_livepatches ~failed_livepatches |> List.filter (fun g -> g <> Guidance.EvacuateHost) + |> fun l -> merge_with_unapplied_guidances ~__context ~host ~guidances:l in - let guidances' = - merge_with_unapplied_guidances ~__context ~host ~kind:Recommended - ~guidances - in + GuidanceSet.assert_valid_guidances guidances' ; match failed_livepatches with | [] -> - (* No livepatch should be applicable now *) - Db.Host.remove_pending_guidances ~__context ~self:host - ~value:`reboot_host_on_livepatch_failure ; - (guidances', guidances') + guidances' | _ :: _ -> (* There is(are) livepatch failure(s): * the host should not be rebooted, and * an extra pending guidance 'RebootHostOnLivePatchFailure' should be set. *) - ( List.filter (fun g -> g <> Guidance.RebootHost) guidances' - , Guidance.RebootHostOnLivePatchFailure :: guidances' - ) + guidances' + |> List.filter (fun g -> g <> Guidance.RebootHost) + |> List.cons Guidance.RebootHostOnLivePatchFailure in - List.iter - (fun g -> debug "recommended_guidance: %s" (Guidance.to_string g)) - recommended_guidances ; List.iter (fun g -> debug "pending_guidance: %s" (Guidance.to_string g)) - pending_guidances ; - GuidanceSet.assert_valid_guidances recommended_guidances ; - set_recommended_guidances ~__context ~host ~guidances:recommended_guidances ; - set_pending_guidances ~__context ~host ~guidances:pending_guidances ; - ( recommended_guidances + guidances ; + set_pending_guidances ~__context ~host ~guidances ; + ( guidances , List.map (fun (lp, _) -> [Api_errors.apply_livepatch_failed; LivePatch.to_string lp] diff --git a/ocaml/xapi/repository_helpers.ml b/ocaml/xapi/repository_helpers.ml index b12970e53e6..8a379c72733 100644 --- a/ocaml/xapi/repository_helpers.ml +++ b/ocaml/xapi/repository_helpers.ml @@ -650,18 +650,14 @@ let eval_guidances ~updates_info ~updates ~kind ~livepatches ~failed_livepatches |> GuidanceSet.resort_guidances ~kind |> GuidanceSet.elements -let merge_with_unapplied_guidances ~__context ~host ~kind ~guidances = +let merge_with_unapplied_guidances ~__context ~host ~guidances = let open GuidanceSet in - ( match kind with - | Guidance.Absolute -> - Db.Host.get_pending_guidances ~__context ~self:host - | Guidance.Recommended -> - Db.Host.get_recommended_guidances ~__context ~self:host - ) + Db.Host.get_pending_guidances ~__context ~self:host |> List.map (fun g -> Guidance.of_update_guidance g) + |> List.filter (fun g -> g <> Guidance.RebootHostOnLivePatchFailure) |> of_list |> union (of_list guidances) - |> resort_guidances ~kind + |> resort_guidances ~kind:Guidance.Recommended |> elements let repoquery_sep = ":|" diff --git a/ocaml/xapi/xapi_host.ml b/ocaml/xapi/xapi_host.ml index 07751829607..a7882193d97 100644 --- a/ocaml/xapi/xapi_host.ml +++ b/ocaml/xapi/xapi_host.ml @@ -3040,16 +3040,16 @@ let set_https_only ~__context ~self ~value = (* it is illegal changing the firewall/https config in CC/FIPS mode *) raise (Api_errors.Server_error (Api_errors.illegal_in_fips_mode, [])) -let try_restart_device_models_for_recommended_guidances ~__context ~host = +let try_restart_device_models ~__context ~host = (* This function runs on master host: restart device models of all running * HVM VMs on the host by doing local migrations if it is required by - * recommended guidances. *) + * guidances. *) Helpers.assert_we_are_master ~__context ; Repository_helpers.do_with_device_models ~__context ~host @@ fun (ref, record) -> match ( List.mem `restart_device_model - (Db.VM.get_recommended_guidances ~__context ~self:ref) + (Db.VM.get_pending_guidances ~__context ~self:ref) , record.API.vM_power_state , Helpers.has_qemu_currently ~__context ~self:ref ) @@ -3065,7 +3065,7 @@ let try_restart_device_models_for_recommended_guidances ~__context ~host = (Ref.string_of ref) ; Some ref | _ -> - (* No `restart_device_model as recommended guidance for this VM or no + (* No `restart_device_model as guidance for this VM or no * device models are running for this VM *) None @@ -3074,23 +3074,25 @@ let apply_recommended_guidances ~__context ~self:host = Helpers.assert_we_are_master ~__context ; try let open Updateinfo in - Db.Host.get_recommended_guidances ~__context ~self:host |> function + Db.Host.get_pending_guidances ~__context ~self:host + (* Ingore the guidance as this has to be handled by user *) + |> List.filter (fun g -> g <> `reboot_host_on_livepatch_failure) + |> function | [] -> - try_restart_device_models_for_recommended_guidances ~__context ~host + try_restart_device_models ~__context ~host | [`reboot_host] -> Helpers.call_api_functions ~__context (fun rpc session_id -> Client.Client.Host.reboot ~rpc ~session_id ~host ) | [`restart_toolstack] -> - try_restart_device_models_for_recommended_guidances ~__context ~host ; + try_restart_device_models ~__context ~host ; Helpers.call_api_functions ~__context (fun rpc session_id -> Client.Client.Host.restart_agent ~rpc ~session_id ~host ) | l -> let host' = Ref.string_of host in error - "Found wrong guidance(s) when applying recommended guidances on host \ - ref='%s': %s" + "Found wrong guidance(s) when applying guidances on host ref='%s': %s" host' (String.concat ";" (List.map Guidance.to_string @@ -3100,6 +3102,6 @@ let apply_recommended_guidances ~__context ~self:host = raise Api_errors.(Server_error (apply_guidance_failed, [host'])) with e -> let host' = Ref.string_of host in - error "applying recommended guidances on host ref='%s' failed: %s" host' + error "applying guidances on host ref='%s' failed: %s" host' (ExnHelper.string_of_exn e) ; raise Api_errors.(Server_error (apply_guidance_failed, [host'])) diff --git a/ocaml/xapi/xapi_host_helpers.ml b/ocaml/xapi/xapi_host_helpers.ml index b5e308d1bbb..f9b38a84c31 100644 --- a/ocaml/xapi/xapi_host_helpers.ml +++ b/ocaml/xapi/xapi_host_helpers.ml @@ -374,16 +374,12 @@ let consider_enabling_host_nolock ~__context = let pool = Helpers.get_pool ~__context in Db.Host.remove_pending_guidances ~__context ~self:localhost ~value:`restart_toolstack ; - Db.Host.remove_recommended_guidances ~__context ~self:localhost - ~value:`restart_toolstack ; if !Xapi_globs.on_system_boot then ( debug "Host.enabled: system has just restarted: setting localhost to enabled" ; Db.Host.set_enabled ~__context ~self:localhost ~value:true ; Db.Host.remove_pending_guidances ~__context ~self:localhost ~value:`reboot_host ; - Db.Host.remove_recommended_guidances ~__context ~self:localhost - ~value:`reboot_host ; Db.Host.remove_pending_guidances ~__context ~self:localhost ~value:`reboot_host_on_livepatch_failure ; update_allowed_operations ~__context ~self:localhost ; From b07b9bf41f1c1538b4682ab55d1c05c8b4f144b0 Mon Sep 17 00:00:00 2001 From: Rob Hoes Date: Fri, 18 Aug 2023 09:54:38 +0000 Subject: [PATCH 4/5] CA-381133: Remove now-unused recommended_guidances fields Signed-off-by: Rob Hoes (cherry picked from commit 4b27b241d2f18c8091e5cbbd62c6e03448ec4ca3) --- ocaml/idl/datamodel_common.ml | 2 +- ocaml/idl/datamodel_host.ml | 3 ++- ocaml/idl/datamodel_vm.ml | 3 ++- ocaml/idl/schematest.ml | 2 +- 4 files changed, 6 insertions(+), 4 deletions(-) diff --git a/ocaml/idl/datamodel_common.ml b/ocaml/idl/datamodel_common.ml index b828331e712..fd2c0dca28a 100644 --- a/ocaml/idl/datamodel_common.ml +++ b/ocaml/idl/datamodel_common.ml @@ -10,7 +10,7 @@ open Datamodel_roles to leave a gap for potential hotfixes needing to increment the schema version.*) let schema_major_vsn = 5 -let schema_minor_vsn = 765 +let schema_minor_vsn = 766 (* Historical schema versions just in case this is useful later *) let rio_schema_major_vsn = 5 diff --git a/ocaml/idl/datamodel_host.ml b/ocaml/idl/datamodel_host.ml index a97873766c0..d883838d7b8 100644 --- a/ocaml/idl/datamodel_host.ml +++ b/ocaml/idl/datamodel_host.ml @@ -2135,7 +2135,8 @@ let t = ; field ~qualifier:DynamicRO ~lifecycle:[] ~ty:Bool ~default_value:(Some (VBool false)) "https_only" "Reflects whether port 80 is open (false) or not (true)" - ; field ~qualifier:DynamicRO ~internal_only:true ~lifecycle:[] + ; field ~qualifier:DynamicRO ~internal_only:true + ~lifecycle:[(Prototyped, "23.18.0", ""); (Removed, "23.24.0", "")] ~ty:(Set update_guidances) "recommended_guidances" ~default_value:(Some (VSet [])) "The set of recommended guidances after applying updates" diff --git a/ocaml/idl/datamodel_vm.ml b/ocaml/idl/datamodel_vm.ml index 3b673ae4538..6b553c9d737 100644 --- a/ocaml/idl/datamodel_vm.ml +++ b/ocaml/idl/datamodel_vm.ml @@ -2141,7 +2141,8 @@ let t = ~ty:(Set update_guidances) "pending_guidances" ~default_value:(Some (VSet [])) "The set of pending guidances after applying updates" - ; field ~qualifier:DynamicRO ~internal_only:true ~lifecycle:[] + ; field ~qualifier:DynamicRO ~internal_only:true + ~lifecycle:[(Prototyped, "23.18.0", ""); (Removed, "23.24.0", "")] ~ty:(Set update_guidances) "recommended_guidances" ~default_value:(Some (VSet [])) "The set of recommended guidances after applying updates" diff --git a/ocaml/idl/schematest.ml b/ocaml/idl/schematest.ml index db8515531db..980bf028c22 100644 --- a/ocaml/idl/schematest.ml +++ b/ocaml/idl/schematest.ml @@ -2,7 +2,7 @@ let hash x = Digest.string x |> Digest.to_hex (* BEWARE: if this changes, check that schema has been bumped accordingly in ocaml/idl/datamodel_common.ml, usually schema_minor_vsn *) -let last_known_schema_hash = "4afbb7a630383c292bc88394f0b3f0d8" +let last_known_schema_hash = "6109500e5b2317376c5a8d50ae12ae59" let current_schema_hash : string = let open Datamodel_types in From d5e9532d8b513ade33b742b9d0cf3a14975321a6 Mon Sep 17 00:00:00 2001 From: Rob Hoes Date: Fri, 18 Aug 2023 10:52:22 +0000 Subject: [PATCH 5/5] Change argument of resort_guidances Signed-off-by: Rob Hoes (cherry picked from commit a1a1562abe7f8d415dfc594b22953e5e9c629dc2) --- ocaml/tests/test_repository_helpers.ml | 3 ++- ocaml/xapi/repository_helpers.ml | 11 +++++++---- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/ocaml/tests/test_repository_helpers.ml b/ocaml/tests/test_repository_helpers.ml index f474f36bb48..8770b23bce5 100644 --- a/ocaml/tests/test_repository_helpers.ml +++ b/ocaml/tests/test_repository_helpers.ml @@ -2755,7 +2755,8 @@ module GuidanceSetResortGuidancesTest = Generic.MakeStateless (struct let transform (kind, guidances) = guidances |> GuidanceSet.of_list - |> GuidanceSet.resort_guidances ~kind + |> GuidanceSet.resort_guidances + ~remove_evacuations:(kind = Guidance.Absolute) |> GuidanceSet.elements let tests = diff --git a/ocaml/xapi/repository_helpers.ml b/ocaml/xapi/repository_helpers.ml index 8a379c72733..1dfb346492a 100644 --- a/ocaml/xapi/repository_helpers.ml +++ b/ocaml/xapi/repository_helpers.ml @@ -132,7 +132,7 @@ module GuidanceSet = struct ; (EvacuateHost, of_list [RestartDeviceModel]) ] - let resort_guidances ~kind gs = + let resort_guidances ~remove_evacuations gs = let gs' = List.fold_left (fun acc (higher, lowers) -> @@ -143,7 +143,10 @@ module GuidanceSet = struct ) gs precedences in - match kind with Recommended -> gs' | Absolute -> remove EvacuateHost gs' + if remove_evacuations then + remove EvacuateHost gs' + else + gs' end let create_repository_record ~__context ~name_label ~name_description @@ -647,7 +650,7 @@ let eval_guidances ~updates_info ~updates ~kind ~livepatches ~failed_livepatches ) GuidanceSet.empty updates |> append_livepatch_guidances ~updates_info ~upd_ids_of_livepatches - |> GuidanceSet.resort_guidances ~kind + |> GuidanceSet.resort_guidances ~remove_evacuations:(kind = Guidance.Absolute) |> GuidanceSet.elements let merge_with_unapplied_guidances ~__context ~host ~guidances = @@ -657,7 +660,7 @@ let merge_with_unapplied_guidances ~__context ~host ~guidances = |> List.filter (fun g -> g <> Guidance.RebootHostOnLivePatchFailure) |> of_list |> union (of_list guidances) - |> resort_guidances ~kind:Guidance.Recommended + |> resort_guidances ~remove_evacuations:false |> elements let repoquery_sep = ":|"