Merge pull request #5155 from robhoes/23.19-lcm

CA-381133 backport to 23.19

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 = 766
 
 (* Historical schema versions just in case this is useful later *)
 let rio_schema_major_vsn = 5

ocaml/idl/datamodel_host.ml

@@ -2135,8 +2135,10 @@ 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:[(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"
         ; field ~qualifier:DynamicRO ~lifecycle:[]
             ~ty:latest_synced_updates_applied_state

ocaml/idl/datamodel_vm.ml

@@ -2141,8 +2141,10 @@ 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:[(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"
         ]
       )

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 = "6109500e5b2317376c5a8d50ae12ae59"
 
 let current_schema_hash : string =
   let open Datamodel_types in

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 =

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

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,54 +730,33 @@ let apply_updates' ~__context ~host ~updates_info ~livepatches ~acc_rpm_updates
         )
       ]
       ) ;
-  (* Evaluate recommended/pending guidances *)
-  let recommended_guidances, pending_guidances =
-    let new_recommended_gs =
+  (* 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 recommended_guidances' =
-      merge_with_unapplied_guidances ~__context ~host ~kind:Recommended
-        ~guidances:new_recommended_gs
-    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
-
+    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 ;
-        (recommended_guidances', pending_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'
-        )
+        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]

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,21 +650,17 @@ 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 ~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 ~remove_evacuations:false
   |> elements
 
 let repoquery_sep = ":|"

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']))

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 ;