diff --git a/ocaml/quicktest/qt.ml b/ocaml/quicktest/qt.ml index fc7c97d03a3..0e72dfc25e0 100644 --- a/ocaml/quicktest/qt.ml +++ b/ocaml/quicktest/qt.ml @@ -118,22 +118,20 @@ module VM = struct let other = "Other install media" let find rpc session_id startswith = - let vms = Client.Client.VM.get_all ~rpc ~session_id in + let vms = Client.Client.VM.get_all_records ~rpc ~session_id in match List.filter - (fun self -> - String.starts_with ~prefix:startswith - (Client.Client.VM.get_name_label ~rpc ~session_id ~self) - && Client.Client.VM.get_is_a_template ~rpc ~session_id ~self + (fun (_, self) -> + String.starts_with ~prefix:startswith self.API.vM_name_label + && self.API.vM_is_a_template ) vms with | [] -> None - | x :: _ -> - Printf.printf "Choosing template with name: %s\n" - (Client.Client.VM.get_name_label ~rpc ~session_id ~self:x) ; - Some x + | (r, vm) :: _ -> + Printf.printf "Choosing template with name: %s\n" vm.API.vM_name_label ; + Some r end let install rpc session_id ~template ~name ?sr () = @@ -152,16 +150,29 @@ module VM = struct cmd @ Option.fold ~none:[] ~some:(fun x -> ["sr-uuid=" ^ x]) sr_uuid in let newvm_uuid = cli_cmd cmd in - Client.Client.VM.get_by_uuid ~rpc ~session_id ~uuid:newvm_uuid + (newvm_uuid, Client.Client.VM.get_by_uuid ~rpc ~session_id ~uuid:newvm_uuid) let uninstall rpc session_id vm = let uuid = Client.Client.VM.get_uuid ~rpc ~session_id ~self:vm in cli_cmd ["vm-uninstall"; "uuid=" ^ uuid; "--force"] |> ignore - let with_new rpc session_id ~template ?sr f = - let vm = + let with_new rpc session_id ~template ?iso ?sr f = + let uuid, vm = install rpc session_id ~template ~name:"temp_quicktest_vm" ?sr () in + iso + |> Option.iter (fun iso -> + let (_ : string) = + cli_cmd + [ + "vm-cd-add" + ; "uuid=" ^ uuid + ; "cd-name=" ^ iso.API.vDI_name_label + ; "device=0" + ] + in + () + ) ; Xapi_stdext_pervasives.Pervasiveext.finally (fun () -> f vm) (fun () -> uninstall rpc session_id vm) diff --git a/ocaml/quicktest/qt.mli b/ocaml/quicktest/qt.mli index e0f2bb8acb2..c85400f9d57 100644 --- a/ocaml/quicktest/qt.mli +++ b/ocaml/quicktest/qt.mli @@ -53,6 +53,7 @@ module VM : sig rpc -> API.ref_session -> template:API.ref_VM + -> ?iso:API.vDI_t -> ?sr:API.ref_SR -> (API.ref_VM -> 'a) -> 'a diff --git a/ocaml/quicktest/qt_filter.ml b/ocaml/quicktest/qt_filter.ml index 744b0545a16..438c3b9a7a8 100644 --- a/ocaml/quicktest/qt_filter.ml +++ b/ocaml/quicktest/qt_filter.ml @@ -17,11 +17,12 @@ let vdi_count = Hashtbl.create 4 let count_vdis rpc session_id sr = Client.Client.SR.scan ~rpc ~session_id ~sr ; let managed_vdis = - Client.Client.SR.get_VDIs ~rpc ~session_id ~self:sr + let expr = + Printf.sprintf {|field "SR"="%s" and field "managed" = "true"|} + (Ref.string_of sr) + in + Client.Client.VDI.get_all_records_where ~rpc ~session_id ~expr (* NB vhd backends may delete records beneath us *) - |> Valid_ref_list.filter (fun vdi -> - Client.Client.VDI.get_managed ~rpc ~session_id ~self:vdi - ) in List.length managed_vdis @@ -47,7 +48,14 @@ let init () = Client.Client.SR.get_all_records ~rpc:!A.rpc ~session_id:!session_id |> List.iter (fun (ref, sr) -> if test_sr_uuid = "" || sr.API.sR_uuid = test_sr_uuid then - if List.mem `scan sr.API.sR_allowed_operations then + if + List.( + mem `scan sr.API.sR_allowed_operations + && (mem `vdi_create sr.API.sR_allowed_operations + || mem `vdi_destroy sr.API.sR_allowed_operations + ) + ) + then let before = count_vdis !A.rpc !session_id ref in Hashtbl.add vdi_count sr.API.sR_uuid before ) @@ -61,7 +69,14 @@ let finish () = match Hashtbl.find_opt vdi_count sr.API.sR_uuid with | Some before -> if test_sr_uuid = "" || sr.API.sR_uuid = test_sr_uuid then - if List.mem `scan sr.API.sR_allowed_operations then + if + List.( + mem `scan sr.API.sR_allowed_operations + && (mem `vdi_create sr.API.sR_allowed_operations + || mem `vdi_destroy sr.API.sR_allowed_operations + ) + ) + then let after = count_vdis !A.rpc !session_id ref in if after <> before then failwith @@ -241,6 +256,13 @@ module SR = struct <> "iso" ) + let is_iso = + sr_filter (fun sr_info -> + Client.Client.SR.get_content_type ~rpc:!A.rpc ~session_id:!session_id + ~self:sr_info.Qt.sr + = "iso" + ) + let is_empty = function [] -> true | _ :: _ -> false let with_any_vdi = @@ -248,10 +270,11 @@ module SR = struct List.mem `vdi_create sr_info.Qt.allowed_operations && List.mem `vdi_destroy sr_info.Qt.allowed_operations || not - (is_empty + (Seq.is_empty (Client.Client.SR.get_VDIs ~rpc:!A.rpc ~session_id:!session_id ~self:sr_info.Qt.sr - |> List.filter (fun vdi -> + |> List.to_seq + |> Seq.filter (fun vdi -> not (Client.Client.VDI.get_missing ~rpc:!A.rpc ~session_id:!session_id ~self:vdi @@ -330,9 +353,10 @@ module SR = struct let list_srs srs = with_xapi_query srs let f srs tcs = - for_each - (fun test_case -> List.map (specialise test_case) (list_srs srs)) - tcs + let srs = list_srs srs in + if srs = [] then + Printf.eprintf "No SRs found that match condition\n" ; + for_each (fun test_case -> List.map (specialise test_case) srs) tcs end let sr = SR.f @@ -342,6 +366,7 @@ let vm_template template_name = with_xapi_query @@ fun () -> match Qt.VM.Template.find !A.rpc !session_id template_name with | None -> + Printf.eprintf "Template not found: %S\n" template_name ; [] | Some vm_template -> [(name, speed, test vm_template)] diff --git a/ocaml/quicktest/qt_filter.mli b/ocaml/quicktest/qt_filter.mli index ba8a7416358..6a4ddb940e4 100644 --- a/ocaml/quicktest/qt_filter.mli +++ b/ocaml/quicktest/qt_filter.mli @@ -51,6 +51,8 @@ module SR : sig val not_iso : srs -> srs + val is_iso : srs -> srs + val with_any_vdi : srs -> srs (** Selects SRs that either have a VDI or we can create & destroy a VDI on them. This filter should be called from tests using [VDI.with_any] *) diff --git a/ocaml/quicktest/quicktest_vm_lifecycle.ml b/ocaml/quicktest/quicktest_vm_lifecycle.ml index b3de6b5b309..63d558c9e36 100644 --- a/ocaml/quicktest/quicktest_vm_lifecycle.ml +++ b/ocaml/quicktest/quicktest_vm_lifecycle.ml @@ -91,11 +91,29 @@ let one rpc session_id vm test = | Halted -> wait_for_domid (fun domid' -> domid' = -1L) -let test rpc session_id sr_info vm_template () = +let test rpc session_id sr_info vm_template iso_info () = let sr = sr_info.Qt.sr in - Qt.VM.with_new rpc session_id ~template:vm_template ~sr (fun vm -> - List.iter (one rpc session_id vm) all_possible_tests - ) + let expr = + Printf.sprintf {|field "SR" = "%s"|} (Ref.string_of iso_info.Qt.sr) + in + let prefix = "memtest" in + let isos = + Client.Client.VDI.get_all_records_where ~rpc ~session_id ~expr + |> List.filter (fun (_, iso) -> + String.starts_with ~prefix iso.API.vDI_name_label + ) + |> List.sort (fun (_, a) (_, b) -> + -String.compare a.API.vDI_name_label b.API.vDI_name_label + ) + in + match isos with + | [] -> + Printf.eprintf "No ISO found with prefix %S\n%!" prefix + | (_, iso) :: _ -> + Printf.eprintf "Choosing ISO %S\n%!" iso.API.vDI_name_label ; + Qt.VM.with_new rpc session_id ~template:vm_template ~iso ~sr (fun vm -> + List.iter (one rpc session_id vm) all_possible_tests + ) let tests () = let open Qt_filter in @@ -103,6 +121,7 @@ let tests () = [("VM lifecycle tests", `Slow, test)] |> conn |> sr SR.(all |> allowed_operations [`vdi_create]) - |> vm_template "CoreOS" + |> vm_template Qt.VM.Template.other + |> sr SR.(all |> is_iso) ] |> List.concat