Supported image formats

ocaml/idl/datamodel.ml

@@ -4998,6 +4998,17 @@ module SR = struct
 end
 
 module SM = struct
+  let formats =
+    [
+      ("raw", "Plain disk image")
+    ; ("vhd", "Virtual Hard Disk")
+    ; ("qcow2", "Qemu Copy-On-Write version 2")
+    ]
+
+  let formats_desc = formats |> List.map fst |> String.concat ", "
+
+  let image_format_type = Enum ("image_format_type", formats)
+
   (** XXX: just make this a field and be done with it. Cowardly refusing to change the schema for now. *)
   let get_driver_filename =
     call ~name:"get_driver_filename" ~in_oss_since:None
@@ -5118,6 +5129,10 @@ module SM = struct
             ~ty:(Set String) "required_cluster_stack"
             "The storage plugin requires that one of these cluster stacks is \
              configured and running."
+        ; field ~lifecycle:[] ~qualifier:DynamicRO
+            ~default_value:(Some (VSet [])) ~ty:(Set image_format_type)
+            "supported_image_formats"
+            (Printf.sprintf "Image formats supported by the SR: %s" formats_desc)
         ]
       ()
 end
@@ -5439,6 +5454,10 @@ module VDI = struct
         [
           (Ref _vdi, "vdi", "The VDI to migrate")
         ; (Ref _sr, "sr", "The destination SR")
+        ; ( String
+          , "dest_img_format"
+          , "The image format to use on destination SR: raw, vhd, qcow2"
+          )
         ; (Map (String, String), "options", "Other parameters")
         ]
       ~result:(Ref _vdi, "The new reference of the migrated VDI.")

ocaml/idl/datamodel_common.ml

@@ -10,7 +10,7 @@ open Datamodel_roles
               to leave a gap for potential hotfixes needing to increment the schema version.*)
 let schema_major_vsn = 5
 
-let schema_minor_vsn = 791
+let schema_minor_vsn = 792
 
 (* Historical schema versions just in case this is useful later *)
 let rio_schema_major_vsn = 5

ocaml/idl/datamodel_vm.ml

@@ -1714,6 +1714,13 @@ let migrate_send =
         ; param_release= inverness_release
         ; param_default= Some (VMap [])
         }
+      ; {
+          param_type= Map (Ref _vdi, String)
+        ; param_name= "vdi_format_map"
+        ; param_doc= "Map of source VDI to it's expected type on destination"
+        ; param_release= numbered_release "25.33.0-next"
+        ; param_default= Some (VMap [])
+        }
       ]
     ~result:
       (Ref _vm, "The reference of the newly created VM in the destination pool")
@@ -1781,6 +1788,13 @@ let assert_can_migrate =
         ; param_release= inverness_release
         ; param_default= Some (VMap [])
         }
+      ; {
+          param_type= Map (Ref _vdi, String)
+        ; param_name= "vdi_format_map"
+        ; param_doc= "Map of source VDI to it's expected type on destination"
+        ; param_release= numbered_release "25.33.0-next"
+        ; param_default= Some (VMap [])
+        }
       ]
     ~allowed_roles:_R_VM_POWER_ADMIN
     ~errs:[Api_errors.license_restriction]

ocaml/idl/schematest.ml

@@ -3,7 +3,7 @@ let hash x = Digest.string x |> Digest.to_hex
 (* BEWARE: if this changes, check that schema has been bumped accordingly in
    ocaml/idl/datamodel_common.ml, usually schema_minor_vsn *)
 
-let last_known_schema_hash = "3b20f4304cfaaa7b6213af91ae632e64"
+let last_known_schema_hash = "957db9d8442259d5888ac88c0ae01a7b"
 
 let current_schema_hash : string =
   let open Datamodel_types in

ocaml/tests/common/test_common.ml

@@ -354,11 +354,12 @@ let make_sm ~__context ?(ref = Ref.make ()) ?(uuid = make_uuid ())
     ?(copyright = "") ?(version = "") ?(required_api_version = "")
     ?(capabilities = []) ?(features = default_sm_features)
     ?(host_pending_features = []) ?(configuration = []) ?(other_config = [])
-    ?(driver_filename = "/dev/null") ?(required_cluster_stack = []) () =
+    ?(driver_filename = "/dev/null") ?(required_cluster_stack = [])
+    ?(supported_image_formats = []) () =
   Db.SM.create ~__context ~ref ~uuid ~_type ~name_label ~name_description
     ~vendor ~copyright ~version ~required_api_version ~capabilities ~features
     ~host_pending_features ~configuration ~other_config ~driver_filename
-    ~required_cluster_stack ;
+    ~required_cluster_stack ~supported_image_formats ;
   ref
 
 let make_sr ~__context ?(ref = Ref.make ()) ?(uuid = make_uuid ())

ocaml/tests/test_sm_features.ml

@@ -249,6 +249,7 @@ module CreateSMObject = Generic.MakeStateful (struct
       ; features
       ; configuration= []
       ; required_cluster_stack= []
+      ; supported_image_formats= []
       ; smapi_version= SMAPIv2
       }
 

ocaml/tests/test_vdi_cbt.ml

@@ -30,6 +30,7 @@ let register_smapiv2_server (module S : Storage_interface.Server_impl) sr_ref =
       ; features= []
       ; configuration= []
       ; required_cluster_stack= []
+      ; supported_image_formats= []
       ; smapi_version= SMAPIv2
       }
   in

ocaml/xapi-cli-server/cli_frontend.ml

@@ -1613,6 +1613,7 @@ let rec cmdtable_data : (string * cmd_spec) list =
           ; "compress"
           ; "vif:"
           ; "vdi:"
+          ; "image-format:"
           ]
       ; help=
           "Migrate the selected VM(s). The parameter '--live' will migrate the \
@@ -1626,7 +1627,9 @@ let rec cmdtable_data : (string * cmd_spec) list =
            'copy=true' will enable the copy mode so that a stopped vm can be \
            copied, instead of migrating, to the destination pool. The vif and \
            vdi mapping parameters take the form 'vif:<source vif uuid>=<dest \
-           network uuid>' and 'vdi:<source vdi uuid>=<dest sr uuid>'. \
+           network uuid>' and 'vdi:<source vdi uuid>=<dest sr uuid>'. You can \
+           also specify the destination image format of the VDI using \
+           'image-format:<source vdi uuid>=<destination image format>'. \
            Unfortunately, destination uuids cannot be tab-completed."
       ; implementation= No_fd Cli_operations.vm_migrate
       ; flags= [Standard; Vm_selectors]
@@ -2468,10 +2471,10 @@ let rec cmdtable_data : (string * cmd_spec) list =
   ; ( "vdi-pool-migrate"
     , {
         reqd= ["uuid"; "sr-uuid"]
-      ; optn= []
+      ; optn= ["dest-img-format"]
       ; help=
-          "Migrate a VDI to a specified SR, while the VDI is attached to a \
-           running guest."
+          "Migrate a VDI to a specified SR, while it is attached to a running \
+           guest. You can specify the image format for the destination."
       ; implementation= No_fd Cli_operations.vdi_pool_migrate
       ; flags= []
       }

ocaml/xapi-cli-server/cli_operations.ml

@@ -2064,8 +2064,12 @@ let vdi_pool_migrate printer rpc session_id params =
     Client.VDI.get_by_uuid ~rpc ~session_id ~uuid:(List.assoc "uuid" params)
   and sr =
     Client.SR.get_by_uuid ~rpc ~session_id ~uuid:(List.assoc "sr-uuid" params)
+  and dest_img_format =
+    List.assoc_opt "dest-img-format" params |> Option.value ~default:""
   and options = [] (* no options implemented yet *) in
-  let newvdi = Client.VDI.pool_migrate ~rpc ~session_id ~vdi ~sr ~options in
+  let newvdi =
+    Client.VDI.pool_migrate ~rpc ~session_id ~vdi ~sr ~dest_img_format ~options
+  in
   let newuuid = Client.VDI.get_uuid ~rpc ~session_id ~self:newvdi in
   printer (Cli_printer.PList [newuuid])
 
@@ -4592,6 +4596,7 @@ let vm_migrate_sxm_params =
   ; "remote-network"
   ; "vdi"
   ; "vgpu"
+  ; "image-format"
   ]
 
 let vm_migrate printer rpc session_id params =
@@ -4896,12 +4901,23 @@ let vm_migrate printer rpc session_id params =
         let token =
           remote Client.Host.migrate_receive ~host ~network ~options
         in
+        let vdi_format_map =
+          List.map
+            (fun (vdi_uuid, vdi_fmt) ->
+              let vdi =
+                Client.VDI.get_by_uuid ~rpc ~session_id ~uuid:vdi_uuid
+              in
+              (vdi, vdi_fmt)
+            )
+            (read_map_params "image-format" params)
+        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:(vm.getref ())
-                ~dest:token ~live:true ~vdi_map ~vif_map ~options ~vgpu_map
+                ~dest:token ~live:true ~vdi_map ~vdi_format_map ~vif_map
+                ~options ~vgpu_map
             )
             params
             (["host"; "host-uuid"; "host-name"; "live"; "force"; "copy"]

ocaml/xapi-cli-server/records.ml

@@ -3865,6 +3865,12 @@ let sm_record rpc session_id sm =
       ; make_field ~name:"required-cluster-stack"
           ~get:(fun () -> concat_with_comma (x ()).API.sM_required_cluster_stack)
           ()
+      ; make_field ~name:"supported-image-formats"
+          ~get:(fun () ->
+            map_and_concat Record_util.image_format_type_to_string
+              (x ()).API.sM_supported_image_formats
+          )
+          ()
       ]
   }
 

ocaml/xapi-idl/storage/storage_interface.ml

@@ -264,6 +264,8 @@ let string_of_vdi_info (x : vdi_info) = Jsonrpc.to_string (rpc_of vdi_info x)
     "datapaths". *)
 type dp = string [@@deriving rpcty]
 
+type image_format_t = string [@@deriving rpcty]
+
 type sock_path = string [@@deriving rpcty]
 
 type dp_stat_t = {
@@ -476,6 +478,7 @@ type query_result = {
   ; features: string list
   ; configuration: (string * string) list
   ; required_cluster_stack: string list
+  ; supported_image_formats: string list
   ; smapi_version: smapi_version
 }
 [@@deriving rpcty]
@@ -1034,6 +1037,8 @@ module StorageAPI (R : RPC) = struct
     declare "get_by_name" [] (dbg_p @-> name_p @-> returning result_p err)
 
   module DATA = struct
+    let image_format_p = Param.mk ~name:"image_format" image_format_t
+
     let url_p = Param.mk ~name:"url" Types.string
 
     let dest_p = Param.mk ~name:"dest" Sr.t
@@ -1065,6 +1070,7 @@ module StorageAPI (R : RPC) = struct
         (dbg_p
         @-> sr_p
         @-> vdi_p
+        @-> image_format_p
         @-> vm_p
         @-> url_p
         @-> returning operation_p err
@@ -1108,6 +1114,8 @@ module StorageAPI (R : RPC) = struct
         )
 
     module MIRROR = struct
+      let image_format_p = Param.mk ~name:"image_format" image_format_t
+
       let mirror_vm_p = Param.mk ~name:"mirror_vm" Vm.t
 
       let copy_vm_p = Param.mk ~name:"copy_vm" Vm.t
@@ -1116,7 +1124,7 @@ module StorageAPI (R : RPC) = struct
 
       let id_p = Param.mk ~name:"id" Mirror.id
 
-      (** [send_start dbg dp task src_sr vdi mirror_vm mirror_id local_vdi copy_vm 
+      (** [send_start dbg dp task src_sr vdi image_format mirror_vm mirror_id local_vdi copy_vm
       live_vm url remote_mirror dest_sr verify_dest]
       takes the remote mirror [remote_mirror] prepared by the destination host 
       and initiates the mirroring of [vdi] from the source *)
@@ -1133,6 +1141,7 @@ module StorageAPI (R : RPC) = struct
           @-> task_id_p
           @-> src_sr_p
           @-> vdi_p
+          @-> image_format_p
           @-> mirror_vm_p
           @-> id_p
           @-> local_vdi_p
@@ -1158,6 +1167,7 @@ module StorageAPI (R : RPC) = struct
           @-> sr_p
           @-> VDI.vdi_info_p
           @-> id_p
+          @-> image_format_p
           @-> similar_p
           @-> returning result err
           )
@@ -1175,6 +1185,7 @@ module StorageAPI (R : RPC) = struct
           @-> sr_p
           @-> VDI.vdi_info_p
           @-> id_p
+          @-> image_format_p
           @-> similar_p
           @-> vm_p
           @-> returning result err
@@ -1190,6 +1201,7 @@ module StorageAPI (R : RPC) = struct
           @-> sr_p
           @-> VDI.vdi_info_p
           @-> id_p
+          @-> image_format_p
           @-> similar_p
           @-> vm_p
           @-> url_p
@@ -1319,6 +1331,7 @@ module type MIRROR = sig
     -> dp:dp
     -> sr:sr
     -> vdi:vdi
+    -> image_format:string
     -> mirror_vm:vm
     -> mirror_id:Mirror.id
     -> local_vdi:vdi_info
@@ -1336,6 +1349,7 @@ module type MIRROR = sig
     -> sr:sr
     -> vdi_info:vdi_info
     -> id:Mirror.id
+    -> image_format:string
     -> similar:Mirror.similars
     -> Mirror.mirror_receive_result
 
@@ -1345,6 +1359,7 @@ module type MIRROR = sig
     -> sr:sr
     -> vdi_info:vdi_info
     -> id:Mirror.id
+    -> image_format:string
     -> similar:Mirror.similars
     -> vm:vm
     -> Mirror.mirror_receive_result
@@ -1355,6 +1370,7 @@ module type MIRROR = sig
     -> sr:sr
     -> vdi_info:vdi_info
     -> mirror_id:Mirror.id
+    -> image_format:string
     -> similar:Mirror.similars
     -> vm:vm
     -> url:string
@@ -1656,6 +1672,7 @@ module type Server_impl = sig
       -> dbg:debug_info
       -> sr:sr
       -> vdi:vdi
+      -> image_format:string
       -> vm:vm
       -> dest:string
       -> operation
@@ -1843,8 +1860,8 @@ module Server (Impl : Server_impl) () = struct
     S.DATA.copy (fun dbg sr vdi vm url dest verify_dest ->
         Impl.DATA.copy () ~dbg ~sr ~vdi ~vm ~url ~dest ~verify_dest
     ) ;
-    S.DATA.mirror (fun dbg sr vdi vm dest ->
-        Impl.DATA.mirror () ~dbg ~sr ~vdi ~vm ~dest
+    S.DATA.mirror (fun dbg sr vdi image_format vm dest ->
+        Impl.DATA.mirror () ~dbg ~sr ~vdi ~image_format ~vm ~dest
     ) ;
     S.DATA.stat (fun dbg sr vdi vm key ->
         Impl.DATA.stat () ~dbg ~sr ~vdi ~vm ~key
@@ -1856,6 +1873,7 @@ module Server (Impl : Server_impl) () = struct
         dp
         sr
         vdi
+        image_format
         mirror_vm
         mirror_id
         local_vdi
@@ -1866,20 +1884,23 @@ module Server (Impl : Server_impl) () = struct
         dest_sr
         verify_dest
       ->
-        Impl.DATA.MIRROR.send_start () ~dbg ~task_id ~dp ~sr ~vdi ~mirror_vm
-          ~mirror_id ~local_vdi ~copy_vm ~live_vm ~url ~remote_mirror ~dest_sr
-          ~verify_dest
+        Impl.DATA.MIRROR.send_start () ~dbg ~task_id ~dp ~sr ~vdi ~image_format
+          ~mirror_vm ~mirror_id ~local_vdi ~copy_vm ~live_vm ~url ~remote_mirror
+          ~dest_sr ~verify_dest
     ) ;
-    S.DATA.MIRROR.receive_start (fun dbg sr vdi_info id similar ->
-        Impl.DATA.MIRROR.receive_start () ~dbg ~sr ~vdi_info ~id ~similar
+    S.DATA.MIRROR.receive_start (fun dbg sr vdi_info id image_format similar ->
+        Impl.DATA.MIRROR.receive_start () ~dbg ~sr ~vdi_info ~id ~image_format
+          ~similar
     ) ;
-    S.DATA.MIRROR.receive_start2 (fun dbg sr vdi_info id similar vm ->
-        Impl.DATA.MIRROR.receive_start2 () ~dbg ~sr ~vdi_info ~id ~similar ~vm
+    S.DATA.MIRROR.receive_start2
+      (fun dbg sr vdi_info id image_format similar vm ->
+        Impl.DATA.MIRROR.receive_start2 () ~dbg ~sr ~vdi_info ~id ~image_format
+          ~similar ~vm
     ) ;
     S.DATA.MIRROR.receive_start3
-      (fun dbg sr vdi_info mirror_id similar vm url verify_dest ->
+      (fun dbg sr vdi_info mirror_id image_format similar vm url verify_dest ->
         Impl.DATA.MIRROR.receive_start3 () ~dbg ~sr ~vdi_info ~mirror_id
-          ~similar ~vm ~url ~verify_dest
+          ~image_format ~similar ~vm ~url ~verify_dest
     ) ;
     S.DATA.MIRROR.receive_cancel (fun dbg id ->
         Impl.DATA.MIRROR.receive_cancel () ~dbg ~id