quicktest: start running quicktest_vm_lifecycle again

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)

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

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,17 +256,25 @@ 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 =
     sr_filter (fun sr_info ->
         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)]

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

ocaml/quicktest/quicktest_vm_lifecycle.ml

@@ -91,18 +91,37 @@ 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
   [
     [("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