Disallow moving of PGPUs with resident VGPUs

The precondition was checking for PCI.attached_VMs on the PGPU's PCI. This
isn't used for VGPU and so the check was not robust. Now we check using the
resident_VGPUs field of the PGPU from the new API.

Signed-off-by: Si Beaumont <[email protected]>

Author: simonjbeaumont

ocaml/xapi/xapi_pgpu.ml

@@ -102,19 +102,21 @@ let set_GPU_group ~__context ~self ~value =
 	debug "Move PGPU %s -> GPU group %s" (Db.PGPU.get_uuid ~__context ~self)
 		(Db.GPU_group.get_uuid ~__context ~self:value);
 	Mutex.execute gpu_group_m (fun () ->
-		let pci = Db.PGPU.get_PCI ~__context ~self in
-
-		(* Precondition: PGPU not currently in use by a VM *)
-		let attached_vms = Db.PCI.get_attached_VMs ~__context ~self:pci in
-		if attached_vms <> [] then
+		(* Precondition: PGPU has no resident VGPUs *)
+		let resident_vgpus = Db.PGPU.get_resident_VGPUs ~__context ~self in
+		if resident_vgpus <> [] then begin
+			let resident_vms = List.map
+				(fun self -> Db.VGPU.get_VM ~__context ~self) resident_vgpus in
 			raise (Api_errors.Server_error (Api_errors.pgpu_in_use_by_vm,
-				List.map Ref.string_of attached_vms));
+				List.map Ref.string_of resident_vms))
+		end;
 
 		let check_compatibility gpu_type group_types =
 			match group_types with
 			| [] -> true, [gpu_type]
 			| _ -> List.mem gpu_type group_types, group_types in
 
+		let pci = Db.PGPU.get_PCI ~__context ~self in
 		let gpu_type = Xapi_pci.string_of_pci ~__context ~self:pci
 		and group_types = Db.GPU_group.get_GPU_types ~__context ~self:value in
 		match check_compatibility gpu_type group_types with