quicktests: Force VDI format on creation

Sort of a follow-up to #6908, which filtered out SRs that only offer QCOW2
backing files. This commit allows running delta tests on SRs that offer both
QCOW2 and VHD backing files (with QCOW2 as the default).

Not specifying the format on SRs with default image format=qcow2 breaks
delta tests for VHD (since they require two vhd images to calculate
differences between).

Force the format in VDI.create through sm-config instead. The sm-config
parameter is ignored if it's not supported (i.e. on XenServer VHD-only
SMAPIv1 SRs).

Force format=vhd for max_vdi_size tests as well, since they're only exporting
to vhd (and testing its max size), this speeds up the tests.

Signed-off-by: Andrii Sultanov <andriy.sultanov@vates.tech>

Author: last-genius

ocaml/quicktest/qt.ml

@@ -192,20 +192,23 @@ module VDI = struct
 
   let test_vdi_name_description = "VDI for storage quicktest"
 
-  let make rpc session_id ?(virtual_size = 4194304L) sR =
+  let make rpc session_id ?(virtual_size = 4194304L) ?backing_format sR =
+    let sm_config =
+      match backing_format with Some x -> [("image-format", x)] | None -> []
+    in
     Client.Client.VDI.create ~sR ~session_id ~rpc
       ~name_label:test_vdi_name_label
       ~name_description:test_vdi_name_description ~_type:`user ~sharable:false
       ~read_only:false ~virtual_size ~xenstore_data:[] ~other_config:[] ~tags:[]
-      ~sm_config:[]
+      ~sm_config
 
   let with_destroyed rpc session_id self f =
     Xapi_stdext_pervasives.Pervasiveext.finally f (fun () ->
         Client.Client.VDI.destroy ~rpc ~session_id ~self
     )
 
-  let with_new rpc session_id ?(virtual_size = 4194304L) sr f =
-    let self = make rpc session_id ~virtual_size sr in
+  let with_new rpc session_id ?(virtual_size = 4194304L) ?backing_format sr f =
+    let self = make rpc session_id ~virtual_size ?backing_format sr in
     with_destroyed rpc session_id self (fun () -> f self)
 
   let with_any rpc session_id sr_info f =

ocaml/quicktest/qt.mli

@@ -75,6 +75,7 @@ module VDI : sig
        rpc
     -> API.ref_session
     -> ?virtual_size:int64
+    -> ?backing_format:string
     -> API.ref_SR
     -> (API.ref_VDI -> 'a)
     -> 'a

ocaml/quicktest/quicktest_max_vdi_size.ml

@@ -1,6 +1,6 @@
 let with_max_vdi rpc session_id sr f =
   Qt.VDI.with_new rpc session_id ~virtual_size:Constants.max_vhd_size sr
-    (fun vdi ->
+    ~backing_format:"vhd" (fun vdi ->
       (* We write some data to the very end of the VDI to ensure the IO code
          gets tested with large offsets *)
       Qt.VDI.with_open rpc session_id vdi `RW (fun fd ->
@@ -43,7 +43,8 @@ let test_export_import rpc session_id sr_info () =
       |> ignore ;
       Xapi_stdext_pervasives.Pervasiveext.finally
         (fun () ->
-          Qt.VDI.with_new rpc session_id ~virtual_size sR (fun new_vdi ->
+          Qt.VDI.with_new rpc session_id ~virtual_size sR ~backing_format:format
+            (fun new_vdi ->
               let new_vdi_uuid =
                 Client.Client.VDI.get_uuid ~rpc ~session_id ~self:new_vdi
               in

ocaml/quicktest/quicktest_vdi_ops_data_integrity.ml

@@ -57,13 +57,14 @@ let checksum rpc session_id vdi =
       Digest.to_hex (Digest.file path)
   )
 
-let check_vdi_unchanged rpc session_id ~vdi_size ~prepare_vdi ~vdi_op sr_info ()
-    =
+let check_vdi_unchanged rpc session_id ~vdi_size ~prepare_vdi ~vdi_op
+    ~backing_format sr_info () =
   let sR = sr_info.Qt.sr in
-  Qt.VDI.with_new ~virtual_size:vdi_size rpc session_id sR (fun vdi ->
+  Qt.VDI.with_new ~virtual_size:vdi_size ~backing_format rpc session_id sR
+    (fun vdi ->
       prepare_vdi rpc session_id vdi ;
       let checksum_original = checksum rpc session_id vdi in
-      let new_vdi = vdi_op rpc session_id sR vdi in
+      let new_vdi = vdi_op rpc session_id sR vdi backing_format in
       Qt.VDI.with_destroyed rpc session_id new_vdi (fun () ->
           let checksum_copy = checksum rpc session_id new_vdi in
           if checksum_copy <> checksum_original then
@@ -77,11 +78,12 @@ let check_vdi_unchanged rpc session_id ~vdi_size ~prepare_vdi ~vdi_op sr_info ()
   )
 
 let check_vdi_delta rpc session_id ~vdi_size ~prepare_vdi ~prepare_vdi_base
-    ~vdi_op sr_info () =
+    ~vdi_op ~backing_format sr_info () =
   let sR = sr_info.Qt.sr in
-  Qt.VDI.with_new ~virtual_size:vdi_size rpc session_id sR
+  Qt.VDI.with_new ~virtual_size:vdi_size ~backing_format rpc session_id sR
   @@ fun vdi_original ->
-  Qt.VDI.with_new ~virtual_size:vdi_size rpc session_id sR @@ fun base_vdi ->
+  Qt.VDI.with_new ~virtual_size:vdi_size ~backing_format rpc session_id sR
+  @@ fun base_vdi ->
   prepare_vdi rpc session_id vdi_original ;
   let checksum_original = checksum rpc session_id vdi_original in
   prepare_vdi_base rpc session_id base_vdi ;
@@ -96,7 +98,7 @@ let check_vdi_delta rpc session_id ~vdi_size ~prepare_vdi ~prepare_vdi_base
          checksum_copy checksum_original
       )
 
-let copy_vdi rpc session_id sr vdi =
+let copy_vdi rpc session_id sr vdi _ =
   Client.Client.VDI.copy ~rpc ~session_id ~vdi ~base_vdi:API.Ref.null
     ~into_vdi:API.Ref.null ~sr
 
@@ -117,14 +119,15 @@ let export_vdi_to_file ~rpc ~session_id ~exportformat ?base_vdi ~vdi () =
   |> ignore ;
   file
 
-let create_new_vdi ~rpc ~session_id ~sR ~vdi =
+let create_new_vdi ~rpc ~session_id ~sR ~vdi ~backing_format =
   let virtual_size =
     Client.Client.VDI.get_virtual_size ~rpc ~session_id ~self:vdi
   in
+  let sm_config = [("image-format", backing_format)] in
   let new_vdi =
     Client.Client.VDI.create ~rpc ~session_id ~name_label:""
       ~name_description:"" ~sR ~virtual_size ~_type:`user ~sharable:false
-      ~read_only:false ~other_config:[] ~xenstore_data:[] ~sm_config:[] ~tags:[]
+      ~read_only:false ~other_config:[] ~xenstore_data:[] ~sm_config ~tags:[]
   in
   let new_vdi_uuid =
     Client.Client.VDI.get_uuid ~rpc ~session_id ~self:new_vdi
@@ -141,11 +144,13 @@ let import_file_into_vdi ~file ~vdi_uuid ~exportformat =
     ]
   |> ignore
 
-let export_import_vdi rpc session_id ~exportformat sR vdi =
+let export_import_vdi rpc session_id ~exportformat sR vdi backing_format =
   let file = export_vdi_to_file ~rpc ~session_id ~exportformat ~vdi () in
   Xapi_stdext_pervasives.Pervasiveext.finally
     (fun () ->
-      let new_vdi_uuid, new_vdi = create_new_vdi ~rpc ~session_id ~sR ~vdi in
+      let new_vdi_uuid, new_vdi =
+        create_new_vdi ~rpc ~session_id ~sR ~vdi ~backing_format
+      in
       import_file_into_vdi ~file ~vdi_uuid:new_vdi_uuid ~exportformat ;
       new_vdi
     )
@@ -177,79 +182,83 @@ let delta_export_import_vhd = export_delta_import_vdi ~exportformat:"vhd"
 
 let delta_export_import_qcow = export_delta_import_vdi ~exportformat:"qcow2"
 
-let data_integrity_tests vdi_op op_name =
+let data_integrity_tests vdi_op op_name backing_format =
   [
     ( op_name ^ ": small empty VDI"
     , `Slow
-    , check_vdi_unchanged ~vdi_size:Sizes.(4L ** mib) ~prepare_vdi:noop ~vdi_op
+    , check_vdi_unchanged
+        ~vdi_size:Sizes.(4L ** mib)
+        ~prepare_vdi:noop ~vdi_op ~backing_format
     )
   ; ( op_name ^ ": small random VDI"
     , `Slow
     , check_vdi_unchanged
         ~vdi_size:Sizes.(4L ** mib)
-        ~prepare_vdi:write_random_data ~vdi_op
+        ~prepare_vdi:write_random_data ~vdi_op ~backing_format
     )
   ; ( op_name ^ ": small full VDI"
     , `Slow
-    , check_vdi_unchanged ~vdi_size:Sizes.(4L ** mib) ~prepare_vdi:fill ~vdi_op
+    , check_vdi_unchanged
+        ~vdi_size:Sizes.(4L ** mib)
+        ~prepare_vdi:fill ~vdi_op ~backing_format
     )
   ]
 
-let delta_data_integrity_tests vdi_op op_name =
+let delta_data_integrity_tests vdi_op op_name backing_format =
   [
     ( op_name ^ ": delta between empty & empty VDI"
     , `Slow
-    , check_vdi_delta
+    , check_vdi_delta ~backing_format
         ~vdi_size:Sizes.(4L ** mib)
         ~prepare_vdi:noop ~prepare_vdi_base:noop ~vdi_op
     )
   ; ( op_name ^ ": delta between random & empty VDI"
     , `Slow
-    , check_vdi_delta
+    , check_vdi_delta ~backing_format
         ~vdi_size:Sizes.(4L ** mib)
         ~prepare_vdi:write_random_data ~prepare_vdi_base:noop ~vdi_op
     )
   ; ( op_name ^ ": delta between random & random VDI"
     , `Slow
-    , check_vdi_delta
+    , check_vdi_delta ~backing_format
         ~vdi_size:Sizes.(4L ** mib)
         ~prepare_vdi:write_random_data ~prepare_vdi_base:write_random_data
         ~vdi_op
     )
   ; ( op_name ^ ": delta between full and empty VDI"
     , `Slow
-    , check_vdi_delta
+    , check_vdi_delta ~backing_format
         ~vdi_size:Sizes.(4L ** mib)
         ~prepare_vdi:fill ~prepare_vdi_base:noop ~vdi_op
     )
   ; ( op_name ^ ": delta between full and random VDI"
     , `Slow
-    , check_vdi_delta
+    , check_vdi_delta ~backing_format
         ~vdi_size:Sizes.(4L ** mib)
         ~prepare_vdi:fill ~prepare_vdi_base:write_random_data ~vdi_op
     )
   ; ( op_name ^ ": delta between full and full VDI"
     , `Slow
-    , check_vdi_delta
+    , check_vdi_delta ~backing_format
         ~vdi_size:Sizes.(4L ** mib)
         ~prepare_vdi:fill ~prepare_vdi_base:fill ~vdi_op
     )
   ]
 
-let large_data_integrity_tests vdi_op op_name =
+let large_data_integrity_tests vdi_op op_name backing_format =
   let b = Random.int64 16L in
   [
     ( op_name ^ ": ~2GiB empty VDI"
     , `Slow
     , check_vdi_unchanged
         ~vdi_size:Sizes.((2L ** gib) +* b)
-        ~prepare_vdi:noop ~vdi_op
+        ~prepare_vdi:noop ~vdi_op ~backing_format
     )
   ; ( op_name ^ ": ~2GiB random VDI"
     , `Slow
     , check_vdi_unchanged
         ~vdi_size:Sizes.((2L ** gib) +* b)
-        ~prepare_vdi:write_random_data ~vdi_op
+        ~prepare_vdi:write_random_data ~vdi_op ~backing_format
     )
   ]
 
@@ -266,30 +275,33 @@ let supported_gfs2_srs test_case =
   test_case |> conn |> sr (sr_with_vdi_create_destroy |> SR.has_type "gfs2")
 
 let tests () =
-  (data_integrity_tests copy_vdi "VDI.copy" |> supported_srs)
-  @ (large_data_integrity_tests copy_vdi "VDI.copy" |> supported_srs)
+  (data_integrity_tests copy_vdi "VDI.copy" "vhd" |> supported_srs)
+  @ (large_data_integrity_tests copy_vdi "VDI.copy" "vhd" |> supported_srs)
   @ (data_integrity_tests export_import_raw "VDI export/import to/from raw file"
+       "vhd"
     |> supported_srs
     )
   @ (data_integrity_tests export_import_vhd "VDI export/import to/from VHD file"
+       "vhd"
     |> supported_srs
     )
   @ (delta_data_integrity_tests delta_export_import_vhd
-       "VDI delta export/import to/from VHD file"
+       "VDI delta export/import to/from VHD file" "vhd"
     |> supported_srs ~f:Qt_filter.SR.smapiv1
     )
-  @ (data_integrity_tests export_import_tar "VDI export/import to/from TAR file"
+  @ (data_integrity_tests export_import_tar
+       "VDI export/import to/from TAR  file" "vhd"
     |> supported_srs
     )
   @ (data_integrity_tests export_import_qcow
-       "VDI export/import to/from QCOW file"
+       "VDI export/import to/from QCOW file" "qcow2"
     |> supported_srs
     )
   @ (delta_data_integrity_tests delta_export_import_qcow
-       "VDI delta export/import to/from QCOW file"
+       "VDI delta export/import to/from QCOW file" "qcow2"
     |> supported_srs
     )
   @ (large_data_integrity_tests export_import_tar
-       "VDI export/import to/from TAR file"
+       "VDI export/import to/from TAR file" "vhd"
     |> supported_gfs2_srs
     )