Merge vgpu-migration into master

Author: robhoes

ocaml/database/db_names.ml

@@ -33,6 +33,7 @@ let is_a_snapshot = "is_a_snapshot"
 let is_control_domain = "is_control_domain"
 let platform = "platform"
 let other_config = "other_config"
+let metrics = "metrics"
 let guest_metrics = "guest_metrics"
 let parent = "parent"
 let snapshot_of = "snapshot_of"

ocaml/idl/datamodel.ml

@@ -676,6 +676,10 @@ let _ =
     ~doc:"VGPU type is not one of the PGPU's supported types." ();
   error Api_errors.vgpu_type_not_compatible_with_running_type ["pgpu"; "type"; "running_type"]
     ~doc:"VGPU type is not compatible with one or more of the VGPU types currently running on this PGPU" ();
+  error Api_errors.vgpu_destination_incompatible ["reason"; "vgpu"; "host"]
+    ~doc:"The VGPU is not compatible with any PGPU in the destination." ();
+  error Api_errors.nvidia_tools_error ["host"]
+    ~doc:"Nvidia tools error. Please ensure that the latest Nvidia tools are installed" ();
 
   error Api_errors.openvswitch_not_active []
     ~doc:"This operation needs the OpenVSwitch networking backend to be enabled on all hosts in the pool." ();
@@ -1683,7 +1687,7 @@ let rrd_cf_type = Enum ("rrd_cf_type",
 let vm_get_boot_record = call
     ~name:"get_boot_record"
     ~in_oss_since:None
-    ~in_product_since:rel_rio
+    ~lifecycle:[Published, rel_rio, ""; Deprecated, rel_inverness, "Use the current VM record/fields instead"]
     ~doc:"Returns a record describing the VM's dynamic state, initialised when the VM boots and updated to reflect runtime configuration changes e.g. CPU hotplug"
     ~result:(Record _vm, "A record describing the VM")
     ~params:[Ref _vm, "self", "The VM whose boot-time state to return"]
@@ -2509,12 +2513,15 @@ let vm_migrate_send = call
     ~name: "migrate_send"
     ~in_product_since:rel_tampa
     ~doc: "Migrate the VM to another host.  This can only be called when the specified VM is in the Running state."
-    ~params:[Ref _vm, "vm", "The VM";
-             Map(String,String), "dest", "The result of a Host.migrate_receive call.";
-             Bool, "live", "Live migration";
-             Map (Ref _vdi, Ref _sr), "vdi_map", "Map of source VDI to destination SR";
-             Map (Ref _vif, Ref _network), "vif_map", "Map of source VIF to destination network";
-             Map (String, String), "options", "Other parameters"]
+    ~versioned_params:
+      [{param_type=Ref _vm; param_name="vm"; param_doc="The VM"; param_release=tampa_release; param_default=None};
+       {param_type=Map(String,String); param_name="dest"; param_doc="The result of a Host.migrate_receive call."; param_release=tampa_release;  param_default=None};
+       {param_type=Bool; param_name="live"; param_doc="Live migration"; param_release=tampa_release; param_default=None};
+       {param_type=Map (Ref _vdi, Ref _sr); param_name="vdi_map"; param_doc="Map of source VDI to destination SR"; param_release=tampa_release; param_default=None};
+       {param_type=Map (Ref _vif, Ref _network); param_name="vif_map"; param_doc="Map of source VIF to destination network"; param_release=tampa_release; param_default=None};
+       {param_type=Map (String, String); param_name="options"; param_doc="Other parameters"; param_release=tampa_release; param_default=None};
+       {param_type=Map (Ref _vgpu, Ref _gpu_group); param_name="vgpu_map"; param_doc="Map of source vGPU to destination GPU group"; param_release=inverness_release; param_default=Some (VMap [])}
+      ]
     ~result:(Ref _vm, "The reference of the newly created VM in the destination pool")
     ~errs:[Api_errors.vm_bad_power_state; Api_errors.license_restriction]
     ~allowed_roles:_R_VM_POWER_ADMIN
@@ -2524,15 +2531,33 @@ let vm_assert_can_migrate = call
     ~name:"assert_can_migrate"
     ~in_product_since:rel_tampa
     ~doc:"Assert whether a VM can be migrated to the specified destination."
+    ~versioned_params:
+      [{param_type=Ref _vm; param_name="vm"; param_doc="The VM"; param_release=tampa_release; param_default=None};
+       {param_type=Map(String,String); param_name="dest"; param_doc="The result of a VM.migrate_receive call."; param_release=tampa_release;  param_default=None};
+       {param_type=Bool; param_name="live"; param_doc="Live migration"; param_release=tampa_release; param_default=None};
+       {param_type=Map (Ref _vdi, Ref _sr); param_name="vdi_map"; param_doc="Map of source VDI to destination SR"; param_release=tampa_release; param_default=None};
+       {param_type=Map (Ref _vif, Ref _network); param_name="vif_map"; param_doc="Map of source VIF to destination network"; param_release=tampa_release; param_default=None};
+       {param_type=Map (String, String); param_name="options"; param_doc="Other parameters"; param_release=tampa_release; param_default=None};
+       {param_type=Map (Ref _vgpu, Ref _gpu_group); param_name="vgpu_map"; param_doc="Map of source vGPU to destination GPU group"; param_release=inverness_release; param_default=Some (VMap [])}
+      ]
+    ~allowed_roles:_R_VM_POWER_ADMIN
+    ~errs:[Api_errors.license_restriction]
+    ()
+
+let vm_assert_can_migrate_sender = call
+    ~name:"assert_can_migrate_sender"
+    ~lifecycle:[]
+    ~doc:"Assertions for VM.assert_can_migrate that must be done on the sending host."
     ~params:[
       Ref _vm, "vm", "The VM";
       Map(String,String), "dest", "The result of a VM.migrate_receive call.";
       Bool, "live", "Live migration";
       Map (Ref _vdi, Ref _sr), "vdi_map", "Map of source VDI to destination SR";
       Map (Ref _vif, Ref _network), "vif_map", "Map of source VIF to destination network";
+      Map (Ref _vgpu, Ref _gpu_group), "vgpu_map", "Map of source vGPU to destination GPU group";
       Map (String, String), "options", "Other parameters" ]
     ~allowed_roles:_R_VM_POWER_ADMIN
-    ~errs:[Api_errors.license_restriction]
+    ~hide_from_docs:true
     ()
 
 let vm_s3_suspend = call
@@ -4999,6 +5024,19 @@ let host_mxgpu_vf_setup = call
     ~allowed_roles:_R_VM_OP
     ()
 
+let host_allocate_resources_for_vm = call
+    ~name:"allocate_resources_for_vm"
+    ~lifecycle:[Published, rel_inverness, ""]
+    ~doc:"Reserves the resources for a VM by setting the 'scheduled_to_be_resident_on' fields"
+    ~params:[
+      Ref _host, "self", "The host";
+      Ref _vm, "vm", "The VM";
+      Bool, "live", "Is this part of a live migration?"
+    ]
+    ~hide_from_docs:true
+    ~allowed_roles:_R_VM_OP
+    ()
+
 (** Hosts *)
 let host =
   create_obj ~in_db:true ~in_product_since:rel_rio ~in_oss_since:oss_since_303 ~internal_deprecated_since:None ~persist:PersistEverything ~gen_constructor_destructor:false ~name:_host ~descr:"A physical host" ~gen_events:true
@@ -5090,6 +5128,7 @@ let host =
                 host_set_ssl_legacy;
                 host_apply_guest_agent_config;
                 host_mxgpu_vf_setup;
+                host_allocate_resources_for_vm;
                ]
     ~contents:
       ([ uid _host;
@@ -8023,6 +8062,7 @@ let vm =
                 vm_maximise_memory;
                 vm_migrate_send;
                 vm_assert_can_migrate;
+                vm_assert_can_migrate_sender;
                 vm_get_boot_record;
                 vm_get_data_sources; vm_record_data_source; vm_query_data_source; vm_forget_data_source_archives;
                 assert_operation_valid vm_operations _vm _self;
@@ -9375,6 +9415,7 @@ let pgpu =
       field ~qualifier:DynamicRO ~ty:(Map (Ref _vgpu_type, Int)) ~lifecycle:[Published, rel_vgpu_productisation, ""] ~default_value:(Some (VMap [])) "supported_VGPU_max_capacities" "A map relating each VGPU type supported on this GPU to the maximum number of VGPUs of that type which can run simultaneously on this GPU";
       field ~qualifier:DynamicRO ~ty:(pgpu_dom0_access) ~lifecycle:[Published, rel_cream, ""] ~default_value:(Some (VEnum "enabled")) "dom0_access" "The accessibility of this device from dom0";
       field ~qualifier:DynamicRO ~ty:Bool ~lifecycle:[Published, rel_cream, ""] ~default_value:(Some (VBool false)) "is_system_display_device" "Is this device the system display device";
+      field ~qualifier:DynamicRO ~ty:(Map (String,String)) ~lifecycle:[Published, rel_inverness, ""] ~default_value:(Some (VMap [])) "compatibility_metadata" "PGPU metadata to determine whether a VGPU can migrate between two PGPUs";
     ]
     ()
 
@@ -9529,7 +9570,7 @@ let vgpu =
       field ~qualifier:RW ~ty:(Map (String,String)) ~lifecycle:[Published, rel_boston, ""] "other_config" "Additional configuration" ~default_value:(Some (VMap []));
       field ~qualifier:DynamicRO ~ty:(Ref _vgpu_type) ~lifecycle:[Published, rel_vgpu_tech_preview, ""] "type" "Preset type for this VGPU" ~default_value:(Some (VRef null_ref));
       field ~qualifier:DynamicRO ~ty:(Ref _pgpu) ~lifecycle:[Published, rel_vgpu_tech_preview, ""] "resident_on" "The PGPU on which this VGPU is running" ~default_value:(Some (VRef null_ref));
-      field ~qualifier:DynamicRO ~ty:(Ref _pgpu) ~lifecycle:[Published, rel_dundee, ""] ~internal_only:true "scheduled_to_be_resident_on" "The PGPU on which this VGPU is scheduled to run" ~default_value:(Some (VRef null_ref));
+      field ~qualifier:DynamicRO ~ty:(Ref _pgpu) ~lifecycle:[Published, rel_dundee, ""] "scheduled_to_be_resident_on" "The PGPU on which this VGPU is scheduled to run" ~default_value:(Some (VRef null_ref));
     ]
     ()
 

ocaml/xapi-consts/api_errors.ml

@@ -288,6 +288,8 @@ let pgpu_insufficient_capacity_for_vgpu = "PGPU_INSUFFICIENT_CAPACITY_FOR_VGPU"
 let vgpu_type_not_enabled = "VGPU_TYPE_NOT_ENABLED"
 let vgpu_type_not_supported = "VGPU_TYPE_NOT_SUPPORTED"
 let vgpu_type_not_compatible_with_running_type = "VGPU_TYPE_NOT_COMPATIBLE_WITH_RUNNING_TYPE"
+let vgpu_destination_incompatible = "VGPU_DESTINATION_INCOMPATIBLE"
+let nvidia_tools_error = "NVIDIA_TOOLS_ERROR"
 
 let import_error_generic = "IMPORT_ERROR"
 let import_error_premature_eof = "IMPORT_ERROR_PREMATURE_EOF"

ocaml/xapi-consts/constants.ml

@@ -130,3 +130,6 @@ let storage_migrate_vif_map_key = "maps_to"
 
 (* Abstract size value for tracking PGPU utilisation. *)
 let pgpu_default_size = Int64.mul 1024L 1024L
+
+(* Used to specify mapping of vGPUs to pGPU groups on the remote machine. Stored in VGPU.other_config *)
+let storage_migrate_vgpu_map_key = "maps_to"

ocaml/xapi/cli_operations.ml

@@ -2755,7 +2755,7 @@ let vm_retrieve_wlb_recommendations printer rpc session_id params =
     failwith ("Parameter '"^name^"' is not a field of the VM class. Failed to select VM for operation.")
 
 let vm_migrate_sxm_params = ["remote-master"; "remote-username"; "vif"; "remote-password";
-                             "remote-network"; "vdi"]
+                             "remote-network"; "vdi"; "vgpu"]
 
 let vm_migrate printer rpc session_id params =
   (* Hack to match host-uuid and host-name for backwards compatibility *)
@@ -2825,6 +2825,11 @@ let vm_migrate printer rpc session_id params =
              let vdi = Client.VDI.get_by_uuid rpc session_id vdi_uuid in
              let sr = Client.SR.get_by_uuid remote_rpc remote_session sr_uuid in
              vdi,sr) (read_map_params "vdi" params) in
+         
+         let vgpu_map = List.map (fun (vgpu_uuid,gpu_group_uuid) ->
+             let vgpu = Client.VGPU.get_by_uuid rpc session_id vgpu_uuid in
+             let gpu_group = Client.GPU_group.get_by_uuid remote_rpc remote_session gpu_group_uuid in
+             vgpu,gpu_group) (read_map_params "vgpu" params) in
 
          let default_sr =
            try let pools = Client.Pool.get_all remote_rpc remote_session in
@@ -2864,7 +2869,7 @@ let vm_migrate printer rpc session_id params =
            vdi_map ;
          let token = Client.Host.migrate_receive remote_rpc remote_session host network options in
          let new_vm =
-           do_vm_op ~include_control_vms:false ~include_template_vms:true printer rpc session_id (fun vm -> Client.VM.migrate_send rpc session_id (vm.getref ()) token true vdi_map vif_map options)
+           do_vm_op ~include_control_vms:false ~include_template_vms:true printer rpc session_id (fun vm -> Client.VM.migrate_send rpc session_id (vm.getref ()) token true vdi_map vif_map options vgpu_map)
              params (["host"; "host-uuid"; "host-name"; "live"; "force"; "copy"] @ vm_migrate_sxm_params) |> List.hd in
          if get_bool_param params "copy" then
            printer (Cli_printer.PList [Client.VM.get_uuid remote_rpc remote_session new_vm])

ocaml/xapi/create_misc.ml

@@ -173,16 +173,14 @@ let (+++) = Int64.add
 (**     1. The domain zero record.                                     *)
 (**     2. The domain zero console record.                             *)
 (**     3. The domain zero guest metrics record.                       *)
-(**     4. The domain zero shadow record.                              *)
 (** This function makes sure there is exactly one record of each type. *)
 (** It updates existing records if they are found, or else creates new *)
 (** records for any records that are missing.                          *)
 let rec ensure_domain_zero_records ~__context ~host (host_info: host_info) : unit =
   maybe_upgrade_domain_zero_record ~__context ~host host_info;
   let domain_zero_ref = ensure_domain_zero_record ~__context host_info in
   ensure_domain_zero_console_record ~__context ~domain_zero_ref;
-  ensure_domain_zero_guest_metrics_record ~__context ~domain_zero_ref host_info;
-  ensure_domain_zero_shadow_record ~__context ~domain_zero_ref
+  ensure_domain_zero_guest_metrics_record ~__context ~domain_zero_ref host_info
 
 and maybe_upgrade_domain_zero_record ~__context ~host (host_info: host_info) =
   try
@@ -229,11 +227,6 @@ and ensure_domain_zero_guest_metrics_record ~__context ~domain_zero_ref (host_in
       Db.VM.set_metrics ~__context ~self:domain_zero_ref ~value:metrics_ref
     end
 
-and ensure_domain_zero_shadow_record ~__context ~domain_zero_ref : unit =
-  (* Always create a new shadow record. *)
-  let domain_zero_record = Db.VM.get_record ~__context ~self:domain_zero_ref in
-  Helpers.set_boot_record ~__context ~self:domain_zero_ref domain_zero_record
-
 and create_domain_zero_record ~__context ~domain_zero_ref (host_info: host_info) : unit =
   (* Determine domain 0 memory constraints. *)
   let memory = create_domain_zero_memory_constraints host_info in
@@ -246,8 +239,24 @@ and create_domain_zero_record ~__context ~domain_zero_ref (host_info: host_info)
   let uuid = host_info.dom0_uuid in
   (* FIXME: Assume dom0 has 1 vCPU per Host_cpu for now *)
   let vcpus = calculate_domain_zero_vcpu_count ~__context in
-  let metrics = Ref.make () in
-  (* Now create the database record. *)
+  let metrics = Ref.make () and metrics_uuid = Uuid.to_string (Uuid.make_uuid ()) in
+  let vCPUs_utilisation = [(0L, 0.)] in
+  (* Now create the database records. *)
+  Db.VM_metrics.create ~__context ~ref:metrics ~uuid:metrics_uuid
+    ~memory_actual:0L ~vCPUs_number:0L
+    ~vCPUs_utilisation
+    ~vCPUs_CPU:[]
+    ~vCPUs_params:[]
+    ~vCPUs_flags:[]
+    ~state:[]
+    ~start_time:Date.never
+    ~install_time:Date.never
+    ~last_updated:Date.never
+    ~other_config:[]
+    ~hvm:false
+    ~nested_virt:false
+    ~nomigrate:false
+  ;
   Db.VM.create ~__context ~ref:domain_zero_ref
     ~name_label:("Control domain on host: " ^ host_info.hostname) ~uuid
     ~name_description:"The domain which manages physical devices and manages other domains"

ocaml/xapi/helpers.ml

@@ -458,54 +458,6 @@ let rolling_upgrade_in_progress ~__context =
   with _ ->
     false
 
-let parse_boot_record ~string:lbr =
-  match Xmlrpc_sexpr.sexpr_str_to_xmlrpc lbr with
-  | None     -> API.Legacy.From.vM_t "ret_val" (Xml.parse_string lbr)
-  | Some xml -> API.Legacy.From.vM_t "ret_val" xml
-
-(** Fetch the configuration the VM was booted with *)
-let get_boot_record_of_record ~__context ~string:lbr ~uuid:current_vm_uuid =
-  try
-    parse_boot_record lbr
-  with e ->
-    (* warn "Warning: exception '%s' parsing last booted record (%s) - returning current record instead" lbr (ExnHelper.string_of_exn e); *)
-    Db.VM.get_record ~__context ~self:(Db.VM.get_by_uuid ~__context ~uuid:current_vm_uuid)
-
-let get_boot_record ~__context ~self =
-  let r = Db.VM.get_record_internal ~__context ~self in
-  let lbr = get_boot_record_of_record ~__context ~string:r.Db_actions.vM_last_booted_record ~uuid:r.Db_actions.vM_uuid in
-  (* CA-31903: we now use an unhealthy mix of fields from the boot_records and the live VM.
-     In particular the VM is currently using dynamic_min and max from the live VM -- not the boot-time settings. *)
-  { lbr with
-    API.vM_memory_target = 0L;
-    API.vM_memory_dynamic_min = r.Db_actions.vM_memory_dynamic_min;
-    API.vM_memory_dynamic_max = r.Db_actions.vM_memory_dynamic_max;
-  }
-
-
-let set_boot_record ~__context ~self newbootrec =
-  (* blank last_booted_record field in newbootrec, so we don't just keep encapsulating
-     old last_boot_records in new snapshots! *)
-  let newbootrec = {newbootrec with API.vM_last_booted_record=""; API.vM_bios_strings=[]} in
-  if rolling_upgrade_in_progress ~__context then
-    begin
-      (* during a rolling upgrade, there might be slaves in the pool
-         who have not yet been upgraded to understand sexprs, so
-         let's still talk using the legacy xmlrpc format.
-      *)
-      let xml = Xml.to_string (API.Legacy.To.vM_t newbootrec) in
-      Db.VM.set_last_booted_record ~__context ~self ~value:xml
-    end
-  else
-    begin
-      (* if it's not a rolling upgrade, then we know everyone
-         else in the pool will understand s-expressions.
-      *)
-      let sexpr = Xmlrpc_sexpr.xmlrpc_to_sexpr_str (API.Legacy.To.vM_t newbootrec) in
-      Db.VM.set_last_booted_record ~__context ~self ~value:sexpr
-    end;
-  ()
-
 (** Inspect the current configuration of a VM and return a boot_method type *)
 let boot_method_of_vm ~__context ~vm =
   if vm.API.vM_HVM_boot_policy <> "" then begin
@@ -545,20 +497,18 @@ let boot_method_of_vm ~__context ~vm =
 
 (** Returns true if the supplied VM configuration is HVM.
     NB that just because a VM's current configuration looks like HVM doesn't imply it
-    actually booted that way; you must check the boot_record to be sure *)
-let is_hvm (x: API.vM_t) = x.API.vM_HVM_boot_policy <> ""
+    actually booted that way; you must check the VM_metrics to be sure *)
+let will_boot_hvm_from_record (x: API.vM_t) = x.API.vM_HVM_boot_policy <> ""
 
 let will_boot_hvm ~__context ~self = Db.VM.get_HVM_boot_policy ~__context ~self <> ""
 
 let has_booted_hvm ~__context ~self =
-  let boot_record = get_boot_record ~__context ~self in
-  boot_record.API.vM_HVM_boot_policy <> ""
-
-let has_booted_hvm_of_record ~__context r =
-  let boot_record =
-    get_boot_record_of_record ~__context
-      ~string:r.Db_actions.vM_last_booted_record ~uuid:r.Db_actions.vM_uuid in
-  boot_record.API.vM_HVM_boot_policy <> ""
+  Db.VM_metrics.get_hvm ~__context ~self:(Db.VM.get_metrics ~__context ~self)
+
+let is_hvm ~__context ~self =
+  match Db.VM.get_power_state ~__context ~self with
+  | `Paused | `Running | `Suspended -> has_booted_hvm ~__context ~self
+  | `Halted | _ -> will_boot_hvm ~__context ~self
 
 let is_running ~__context ~self = Db.VM.get_domid ~__context ~self <> -1L