Merge pull request #5152 from robhoes/23.19-lcm

Selected backports for 23.19

ocaml/xapi/cpuid_helpers.ml

@@ -45,9 +45,9 @@ let socket_count = Map_check.(field "socket_count" int)
 
 let vendor = Map_check.(field "vendor" string)
 
-let get_flags_for_vm ~__context domain_type cpu_info =
+let get_flags_for_vm ~__context vm cpu_info =
   let features_field =
-    match domain_type with
+    match Helpers.domain_type ~__context ~self:vm with
     | `hvm | `pv_in_pvh | `pvh ->
         features_hvm
     | `pv ->
@@ -77,51 +77,36 @@ let next_boot_cpu_features ~__context ~vm =
   Map_check.getf features_field_boot pool_cpu_info
   |> Xenops_interface.CPU_policy.to_string
 
-let get_host_cpu_info ~__context ~host ?remote () =
+let get_host_cpu_info ~__context ~vm:_ ~host ?remote () =
   match remote with
   | None ->
       Db.Host.get_cpu_info ~__context ~self:host
   | Some (rpc, session_id) ->
       Client.Client.Host.get_cpu_info ~rpc ~session_id ~self:host
 
-let get_host_compatibility_info ~__context ~domain_type ~host ?remote () =
-  get_host_cpu_info ~__context ~host ?remote ()
-  |> get_flags_for_vm ~__context domain_type
+let get_host_compatibility_info ~__context ~vm ~host ?remote () =
+  get_host_cpu_info ~__context ~vm ~host ?remote ()
+  |> get_flags_for_vm ~__context vm
 
 (* Compare the CPU on which the given VM was last booted to the CPU of the given host. *)
-let assert_vm_is_compatible ~__context ~vm ~host =
-  let vm_ref, vm_rec, domain_type =
-    match vm with
-    | `db self ->
-        ( self
-        , Db.VM.get_record ~__context ~self
-        , Helpers.domain_type ~__context ~self
-        )
-    | `import (vm_rec, dt) ->
-        (* Ref.null, because the VM to be imported does not yet have a ref *)
-        (Ref.null, vm_rec, Helpers.check_domain_type dt)
-  in
+let assert_vm_is_compatible ~__context ~vm ~host ?remote () =
   let fail msg =
     raise
       (Api_errors.Server_error
          ( Api_errors.vm_incompatible_with_this_host
-         , [Ref.string_of vm_ref; Ref.string_of host; msg]
+         , [Ref.string_of vm; Ref.string_of host; msg]
          )
       )
   in
-  if vm_rec.API.vM_power_state <> `Halted then (
-    let host_uuid = Db.Host.get_uuid ~__context ~self:host in
-    debug "Checking CPU compatibility of %s VM %s with host %s"
-      (Record_util.domain_type_to_string domain_type)
-      vm_rec.API.vM_uuid host_uuid ;
+  if Db.VM.get_power_state ~__context ~self:vm <> `Halted then
     let open Xapi_xenops_queue in
     let module Xenopsd = (val make_client (default_xenopsd ()) : XENOPS) in
     let dbg = Context.string_of_task __context in
     try
       let host_cpu_vendor, host_cpu_features =
-        get_host_compatibility_info ~__context ~domain_type ~host ()
+        get_host_compatibility_info ~__context ~vm ~host ?remote ()
       in
-      let vm_cpu_info = vm_rec.API.vM_last_boot_CPU_flags in
+      let vm_cpu_info = Db.VM.get_last_boot_CPU_flags ~__context ~self:vm in
       if List.mem_assoc cpu_info_vendor_key vm_cpu_info then (
         (* Check the VM was last booted on a CPU with the same vendor as this host's CPU. *)
         let vm_cpu_vendor = List.assoc cpu_info_vendor_key vm_cpu_info in
@@ -154,4 +139,3 @@ let assert_vm_is_compatible ~__context ~vm ~host =
       fail
         "Host does not have new leveling feature keys - not comparing VM's \
          flags"
-  )

ocaml/xapi/cpuid_helpers.mli

@@ -16,12 +16,11 @@ val next_boot_cpu_features : __context:Context.t -> vm:[`VM] API.Ref.t -> string
 
 val assert_vm_is_compatible :
      __context:Context.t
-  -> vm:[`db of [`VM] API.Ref.t | `import of API.vM_t * API.domain_type]
+  -> vm:[`VM] API.Ref.t
   -> host:[`host] API.Ref.t
+  -> ?remote:(Rpc.call -> Rpc.response Client.Id.t) * [< `session] Ref.t
+  -> unit
   -> unit
-(** Checks whether the CPU vendor and features used by the VM are compatible
-    with the given host. The VM can be one that is currently in the DB, or a record
-    coming from a metadata import as used for cross-pool migration. *)
 
 val vendor : string Map_check.field
 
@@ -41,6 +40,7 @@ val features_hvm_host : [`host] Xenops_interface.CPU_policy.t Map_check.field
 
 val get_host_cpu_info :
      __context:Context.t
+  -> vm:[`VM] API.Ref.t
   -> host:[`host] API.Ref.t
   -> ?remote:(Rpc.call -> Rpc.response Client.Id.t) * [< `session] Ref.t
   -> unit

ocaml/xapi/export.ml

@@ -137,8 +137,7 @@ let rec update_table ~__context ~include_snapshots ~preserve_power_state
       && Db.is_valid_ref __context vdi
     then
       add_vdi vdi ;
-    (* Add also the metrics and guest metrics *)
-    add vm.API.vM_metrics ;
+    (* Add also the guest metrics *)
     add vm.API.vM_guest_metrics ;
     (* Add the hosts links *)
     add vm.API.vM_resident_on ;
@@ -261,7 +260,7 @@ let make_vm ?(with_snapshot_metadata = false) ~preserve_power_state table
     ; API.vM_resident_on= lookup table (Ref.string_of vm.API.vM_resident_on)
     ; API.vM_affinity= lookup table (Ref.string_of vm.API.vM_affinity)
     ; API.vM_consoles= []
-    ; API.vM_metrics= lookup table (Ref.string_of vm.API.vM_metrics)
+    ; API.vM_metrics= Ref.null
     ; API.vM_guest_metrics= lookup table (Ref.string_of vm.API.vM_guest_metrics)
     ; API.vM_protection_policy= Ref.null
     ; API.vM_bios_strings= vm.API.vM_bios_strings
@@ -274,15 +273,6 @@ let make_vm ?(with_snapshot_metadata = false) ~preserve_power_state table
   ; snapshot= API.rpc_of_vM_t vm
   }
 
-(** Convert a VM metrics reference to an obj *)
-let make_vmm table __context self =
-  let vmm = Db.VM_metrics.get_record ~__context ~self in
-  {
-    cls= Datamodel_common._vm_metrics
-  ; id= Ref.string_of (lookup table (Ref.string_of self))
-  ; snapshot= API.rpc_of_vM_metrics_t vmm
-  }
-
 (** Convert a guest-metrics reference to an obj *)
 let make_gm table __context self =
   let gm = Db.VM_guest_metrics.get_record ~__context ~self in
@@ -512,10 +502,6 @@ let make_all ~with_snapshot_metadata ~preserve_power_state table __context =
       (make_vm ~with_snapshot_metadata ~preserve_power_state table __context)
       (filter table (Db.VM.get_all ~__context))
   in
-  let vmms =
-    List.map (make_vmm table __context)
-      (filter table (Db.VM_metrics.get_all ~__context))
-  in
   let gms =
     List.map (make_gm table __context)
       (filter table (Db.VM_guest_metrics.get_all ~__context))
@@ -576,7 +562,6 @@ let make_all ~with_snapshot_metadata ~preserve_power_state table __context =
     [
       hosts
     ; vms
-    ; vmms
     ; gms
     ; vbds
     ; vifs

ocaml/xapi/import.ml

@@ -50,7 +50,6 @@ type metadata_options = {
        	 * - If the migration is for real, we will expect the VM export code on the source host to have mapped the VDI locations onto their
        	 *   mirrored counterparts which are present on this host. *)
     live: bool
-  ; check_cpu: bool
   ; (* An optional src VDI -> destination VDI rewrite list *)
     vdi_map: (string * string) list
 }
@@ -76,13 +75,6 @@ type config = {
 let is_live config =
   match config.import_type with Metadata_import {live; _} -> live | _ -> false
 
-let needs_cpu_check config =
-  match config.import_type with
-  | Metadata_import {check_cpu; _} ->
-      check_cpu
-  | _ ->
-      false
-
 (** List of (datamodel classname * Reference in export * Reference in database) *)
 type table = (string * string * string) list
 
@@ -261,8 +253,8 @@ let assert_can_restore_backup ~__context rpc session_id (x : header) =
     import_vms
 
 let assert_can_live_import __context vm_record =
-  let host = Helpers.get_localhost ~__context in
   let assert_memory_available () =
+    let host = Helpers.get_localhost ~__context in
     let host_mem_available =
       Memory_check.host_compute_free_memory_with_maximum_compression ~__context
         ~host None
@@ -424,7 +416,7 @@ module VM : HandlerTools = struct
     | Skip
     | Clean_import of API.vM_t
 
-  let precheck __context config _rpc _session_id state x =
+  let precheck __context config _rpc _session_id _state x =
     let vm_record = get_vm_record x.snapshot in
     let is_default_template =
       vm_record.API.vM_is_default_template
@@ -508,21 +500,6 @@ module VM : HandlerTools = struct
       | Replace (_, vm_record) | Clean_import vm_record ->
           if is_live config then
             assert_can_live_import __context vm_record ;
-          ( if needs_cpu_check config then
-              let vmm_record =
-                find_in_export
-                  (Ref.string_of vm_record.API.vM_metrics)
-                  state.export
-                |> API.vM_metrics_t_of_rpc
-              in
-              let host = Helpers.get_localhost ~__context in
-              Cpuid_helpers.assert_vm_is_compatible ~__context
-                ~vm:
-                  (`import
-                    (vm_record, vmm_record.API.vM_metrics_current_domain_type)
-                    )
-                ~host
-          ) ;
           import_action
       | _ ->
           import_action
@@ -741,15 +718,6 @@ module VM : HandlerTools = struct
       then
         Db.VM.set_suspend_SR ~__context ~self:vm ~value:Ref.null ;
       Db.VM.set_parent ~__context ~self:vm ~value:vm_record.API.vM_parent ;
-      ( try
-          let vmm = lookup vm_record.API.vM_metrics state.table in
-          (* We have VM_metrics in the imported metadata, so use it, and destroy
-             the record created by VM.create_from_record above. *)
-          let replaced_vmm = Db.VM.get_metrics ~__context ~self:vm in
-          Db.VM.set_metrics ~__context ~self:vm ~value:vmm ;
-          Db.VM_metrics.destroy ~__context ~self:replaced_vmm
-        with _ -> ()
-      ) ;
       ( try
           let gm = lookup vm_record.API.vM_guest_metrics state.table in
           Db.VM.set_guest_metrics ~__context ~self:vm ~value:gm
@@ -824,40 +792,6 @@ module GuestMetrics : HandlerTools = struct
     state.table <- (x.cls, x.id, Ref.string_of gm) :: state.table
 end
 
-(** Create the VM metrics *)
-module Metrics : HandlerTools = struct
-  type precheck_t = OK
-
-  let precheck __context _config _rpc _session_id _state _x = OK
-
-  let handle_dry_run __context _config _rpc _session_id state x _precheck_result
-      =
-    let dummy_gm = Ref.make () in
-    state.table <- (x.cls, x.id, Ref.string_of dummy_gm) :: state.table
-
-  let handle __context _config _rpc _session_id state x _precheck_result =
-    let vmm_record = API.vM_metrics_t_of_rpc x.snapshot in
-    let vmm = Ref.make () in
-    Db.VM_metrics.create ~__context ~ref:vmm
-      ~uuid:(Uuidx.to_string (Uuidx.make ()))
-      ~memory_actual:vmm_record.API.vM_metrics_memory_actual
-      ~vCPUs_number:vmm_record.API.vM_metrics_VCPUs_number
-      ~vCPUs_utilisation:vmm_record.API.vM_metrics_VCPUs_utilisation
-      ~vCPUs_CPU:vmm_record.API.vM_metrics_VCPUs_CPU
-      ~vCPUs_params:vmm_record.API.vM_metrics_VCPUs_params
-      ~vCPUs_flags:vmm_record.API.vM_metrics_VCPUs_flags
-      ~state:vmm_record.API.vM_metrics_state
-      ~start_time:vmm_record.API.vM_metrics_start_time
-      ~install_time:vmm_record.API.vM_metrics_install_time
-      ~last_updated:vmm_record.API.vM_metrics_last_updated
-      ~other_config:vmm_record.API.vM_metrics_other_config
-      ~hvm:vmm_record.API.vM_metrics_hvm
-      ~nested_virt:vmm_record.API.vM_metrics_nested_virt
-      ~nomigrate:vmm_record.API.vM_metrics_nomigrate
-      ~current_domain_type:vmm_record.API.vM_metrics_current_domain_type ;
-    state.table <- (x.cls, x.id, Ref.string_of vmm) :: state.table
-end
-
 (** If we're restoring VM metadata only then lookup the SR by uuid. If we can't find
     the SR then we will still try to match VDIs later (except CDROMs) *)
 module SR : HandlerTools = struct
@@ -1963,7 +1897,6 @@ module HostHandler = MakeHandler (Host)
 module SRHandler = MakeHandler (SR)
 module VDIHandler = MakeHandler (VDI)
 module GuestMetricsHandler = MakeHandler (GuestMetrics)
-module MetricsHandler = MakeHandler (Metrics)
 module VMHandler = MakeHandler (VM)
 module NetworkHandler = MakeHandler (Net)
 module GPUGroupHandler = MakeHandler (GPUGroup)
@@ -1982,7 +1915,6 @@ let handlers =
   ; (Datamodel_common._sr, SRHandler.handle)
   ; (Datamodel_common._vdi, VDIHandler.handle)
   ; (Datamodel_common._vm_guest_metrics, GuestMetricsHandler.handle)
-  ; (Datamodel_common._vm_metrics, MetricsHandler.handle)
   ; (Datamodel_common._vm, VMHandler.handle)
   ; (Datamodel_common._network, NetworkHandler.handle)
   ; (Datamodel_common._gpu_group, GPUGroupHandler.handle)
@@ -2259,14 +2191,13 @@ let metadata_handler (req : Request.t) s _ =
           let force = find_query_flag req.Request.query "force" in
           let dry_run = find_query_flag req.Request.query "dry_run" in
           let live = find_query_flag req.Request.query "live" in
-          let check_cpu = find_query_flag req.Request.query "check_cpu" in
           let vdi_map = read_map_params "vdi" req.Request.query in
           info
             "VM.import_metadata: force = %b; full_restore = %b dry_run = %b; \
-             live = %b; check_cpu = %b; vdi_map = [ %s ]"
-            force full_restore dry_run live check_cpu
+             live = %b; vdi_map = [ %s ]"
+            force full_restore dry_run live
             (String.concat "; " (List.map (fun (a, b) -> a ^ "=" ^ b) vdi_map)) ;
-          let metadata_options = {dry_run; live; vdi_map; check_cpu} in
+          let metadata_options = {dry_run; live; vdi_map} in
           let config =
             {import_type= Metadata_import metadata_options; full_restore; force}
           in

ocaml/xapi/importexport.ml

@@ -249,7 +249,6 @@ type vm_export_import = {
   ; dry_run: bool
   ; live: bool
   ; send_snapshots: bool
-  ; check_cpu: bool
 }
 
 (* Copy VM metadata to a remote pool *)
@@ -270,12 +269,11 @@ let remote_metadata_export_import ~__context ~rpc ~session_id ~remote_address
       match which with
       | `All ->
           []
-      | `Only {live; dry_run; send_snapshots; check_cpu; _} ->
+      | `Only {live; dry_run; send_snapshots; _} ->
           [
             Printf.sprintf "live=%b" live
           ; Printf.sprintf "dry_run=%b" dry_run
           ; Printf.sprintf "export_snapshots=%b" send_snapshots
-          ; Printf.sprintf "check_cpu=%b" check_cpu
           ]
     in
     let params = Printf.sprintf "restore=%b" restore :: params in

ocaml/xapi/message_forwarding.ml

@@ -2398,7 +2398,7 @@ functor
           try bool_of_string (List.assoc "force" options) with _ -> false
         in
         if not force then
-          Cpuid_helpers.assert_vm_is_compatible ~__context ~vm:(`db vm) ~host ;
+          Cpuid_helpers.assert_vm_is_compatible ~__context ~vm ~host () ;
         let source_host = Db.VM.get_resident_on ~__context ~self:vm in
         with_vm_operation ~__context ~self:vm ~doc:"VM.pool_migrate"
           ~op:`pool_migrate ~strict:(not force) (fun () ->

ocaml/xapi/xapi_dr.ml

@@ -282,7 +282,6 @@ let recover_vms ~__context ~vms ~session_to ~force =
     {
       Import.dry_run= false
     ; Import.live= false
-    ; check_cpu= false
     ; vdi_map= [] (* we expect the VDI metadata to be present *)
     }
   in

ocaml/xapi/xapi_vm.ml

@@ -568,7 +568,7 @@ let resume ~__context ~vm ~start_paused ~force =
   ) ;
   let host = Helpers.get_localhost ~__context in
   if not force then
-    Cpuid_helpers.assert_vm_is_compatible ~__context ~vm:(`db vm) ~host ;
+    Cpuid_helpers.assert_vm_is_compatible ~__context ~vm ~host () ;
   (* Update CPU feature set, which will be passed to xenopsd *)
   Xapi_xenops.resume ~__context ~self:vm ~start_paused ~force
 

ocaml/xapi/xapi_vm_helpers.ml

@@ -647,7 +647,7 @@ let assert_matches_control_domain_affinity ~__context ~self ~host =
 let assert_enough_pcpus ~__context ~self ~host ?remote () =
   let vcpus = Db.VM.get_VCPUs_max ~__context ~self in
   let pcpus =
-    Cpuid_helpers.get_host_cpu_info ~__context ~host ?remote ()
+    Cpuid_helpers.get_host_cpu_info ~__context ~vm:self ~host ?remote ()
     |> Map_check.getf Cpuid_helpers.cpu_count
     |> Int64.of_int
   in
@@ -718,7 +718,7 @@ let assert_can_boot_here ~__context ~self ~host ~snapshot ~do_cpuid_check
   assert_hardware_platform_support ~__context ~vm:self
     ~host:(Helpers.LocalObject host) ;
   if do_cpuid_check then
-    Cpuid_helpers.assert_vm_is_compatible ~__context ~vm:(`db self) ~host ;
+    Cpuid_helpers.assert_vm_is_compatible ~__context ~vm:self ~host () ;
   if do_sr_check then
     assert_can_see_SRs ~__context ~self ~host ;
   assert_can_see_networks ~__context ~self ~host ;