Add an option to specify destination format during migration

This patch introduces two options for specifying a destination image
format during migration.

The first option, `dest-img-format`, is used by `vdi-pool-migrate`. The
provided string is used to check whether the destination SR supports the
expected format. If the check fails—or cannot be performed due to missing
information on the destination SR—an error is returned.

The second option is used by `vm-migrate`, and allows specifying the
destination format for individual VDIs mapped to a destination SR. The
format is `image-format:<source VDI UUID>=<destination image format>`.
As with VDI pool migration, if the destination image format cannot be
validated, an error is returned.

Signed-off-by: Guillaume <[email protected]>

Author: gthvn1

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= "image_format"
+        ; param_doc= "Map of source VDI to destination image format"
+        ; param_release= numbered_release "25.6.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= "image_format"
+        ; param_doc= "Map of source VDI to destination image format"
+        ; param_release= numbered_release "25.6.0-next"
+        ; param_default= Some (VMap [])
+        }
       ]
     ~allowed_roles:_R_VM_POWER_ADMIN
     ~errs:[Api_errors.license_restriction]
@@ -1813,6 +1827,10 @@ let assert_can_migrate_sender =
         , "Map of source vGPU to destination GPU group"
         )
       ; (Map (String, String), "options", "Other parameters")
+      ; ( Map (Ref _vdi, String)
+        , "image_format"
+        , "Map of source VDI to destination image format"
+        )
       ]
     ~allowed_roles:_R_VM_POWER_ADMIN ~hide_from_docs:true ()
 

ocaml/xapi-cli-server/cli_frontend.ml

@@ -1574,6 +1574,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 \
@@ -1587,7 +1588,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]
@@ -2409,7 +2412,7 @@ 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."

ocaml/xapi-cli-server/cli_operations.ml

@@ -135,6 +135,8 @@ let waiter printer rpc session_id params task =
    Works for key which is not follow by a ':',
    also match old syntax 'device-config-key' for backwards compatability *)
 let read_map_params name params =
+  debug "GTNDEBUG: read_map_params name: %s" name ;
+  List.iter (fun (p, _) -> debug "GTNDEBUG: params: %s" p) params ;
   let len = String.length name + 1 in
   (* include ':' *)
   let filter_params =
@@ -2060,7 +2062,13 @@ 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 options = [] (* no options implemented yet *) in
+  and options =
+    [
+      List.assoc_opt "dest-img-format" params
+      |> Option.map (fun fmt -> ("dest_img_format", "&dest-img-format=" ^ fmt))
+    ]
+    |> List.filter_map (fun x -> x)
+  in
   let newvdi = Client.VDI.pool_migrate ~rpc ~session_id ~vdi ~sr ~options in
   let newuuid = Client.VDI.get_uuid ~rpc ~session_id ~self:newvdi in
   printer (Cli_printer.PList [newuuid])
@@ -4544,6 +4552,7 @@ let vm_migrate_sxm_params =
   ; "remote-network"
   ; "vdi"
   ; "vgpu"
+  ; "image-format"
   ]
 
 let vm_migrate printer rpc session_id params =
@@ -4691,6 +4700,17 @@ let vm_migrate printer rpc session_id params =
             )
             (read_map_params "vdi" params)
         in
+        let image_format =
+          List.map
+            (fun (vdi_uuid, img_format) ->
+              let vdi =
+                Client.VDI.get_by_uuid ~rpc ~session_id ~uuid:vdi_uuid
+              in
+              (* TODO: check that image format is valid by checking the SR-UUID *)
+              (vdi, img_format)
+            )
+            (read_map_params "image-format" params)
+        in
         let vgpu_map =
           List.map
             (fun (vgpu_uuid, gpu_group_uuid) ->
@@ -4853,7 +4873,8 @@ let vm_migrate printer rpc session_id params =
             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 ~vif_map ~vgpu_map ~options
+                ~image_format
             )
             params
             (["host"; "host-uuid"; "host-name"; "live"; "force"; "copy"]

ocaml/xapi/message_forwarding.ml

@@ -2516,16 +2516,16 @@ functor
         update_vif_operations ~__context ~vm
 
       let assert_can_migrate_sender ~__context ~vm ~dest ~live ~vdi_map ~vif_map
-          ~vgpu_map ~options =
+          ~vgpu_map ~options ~image_format =
         info "VM.assert_can_migrate_sender: VM = '%s'" (vm_uuid ~__context vm) ;
         let local_fn =
           Local.VM.assert_can_migrate_sender ~vm ~dest ~live ~vdi_map ~vif_map
-            ~vgpu_map ~options
+            ~vgpu_map ~options ~image_format
         in
         try
           forward_vm_op ~local_fn ~__context ~vm (fun session_id rpc ->
               Client.VM.assert_can_migrate_sender ~rpc ~session_id ~vm ~dest
-                ~live ~vdi_map ~vif_map ~vgpu_map ~options
+                ~live ~vdi_map ~vif_map ~vgpu_map ~options ~image_format
           )
         with
         | Api_errors.Server_error (code, _)
@@ -2536,26 +2536,26 @@ functor
              assuming it can ignore this check."
 
       let assert_can_migrate ~__context ~vm ~dest ~live ~vdi_map ~vif_map
-          ~options ~vgpu_map =
+          ~options ~vgpu_map ~image_format =
         info "VM.assert_can_migrate: VM = '%s'" (vm_uuid ~__context vm) ;
         (* Run the checks that can be done using just the DB directly on the master *)
         Local.VM.assert_can_migrate ~__context ~vm ~dest ~live ~vdi_map ~vif_map
-          ~vgpu_map ~options ;
+          ~vgpu_map ~options ~image_format ;
         (* Run further checks on the sending host *)
         assert_can_migrate_sender ~__context ~vm ~dest ~live ~vdi_map ~vif_map
-          ~vgpu_map ~options
+          ~vgpu_map ~options ~image_format
 
       let migrate_send ~__context ~vm ~dest ~live ~vdi_map ~vif_map ~options
-          ~vgpu_map =
+          ~vgpu_map ~image_format =
         info "VM.migrate_send: VM = '%s'" (vm_uuid ~__context vm) ;
         let source_host = Db.VM.get_resident_on ~__context ~self:vm in
         let local_fn =
           Local.VM.migrate_send ~vm ~dest ~live ~vdi_map ~vif_map ~vgpu_map
-            ~options
+            ~options ~image_format
         in
         let op session_id rpc =
           Client.VM.migrate_send ~rpc ~session_id ~vm ~dest ~live ~vdi_map
-            ~vif_map ~options ~vgpu_map
+            ~vif_map ~options ~vgpu_map ~image_format
         in
         let migration_type =
           if Xapi_vm_lifecycle_helpers.is_live ~__context ~self:vm then
@@ -2576,6 +2576,7 @@ functor
                   (fun () ->
                     Client.InternalAsync.VM.migrate_send ~rpc ~session_id ~vm
                       ~dest ~live ~vdi_map ~vif_map ~options ~vgpu_map
+                      ~image_format
                   )
                   (fun () -> op session_id rpc)
             )
@@ -2614,7 +2615,7 @@ functor
               Server_helpers.exec_with_subtask ~__context
                 "VM.assert_can_migrate" (fun ~__context ->
                   assert_can_migrate ~__context ~vm ~dest ~live ~vdi_map
-                    ~vif_map ~vgpu_map ~options
+                    ~vif_map ~vgpu_map ~options ~image_format
               ) ;
               forward_migrate_send ()
           )
@@ -5455,6 +5456,10 @@ functor
         )
 
       let pool_migrate ~__context ~vdi ~sr ~options =
+        debug "GTNDEBUG: pool_migrate from message forwarder...." ;
+        List.iter
+          (fun (s1, s2) -> debug "GTNDEBUG: options (%s, %s)" s1 s2)
+          options ;
         let vbds =
           let expr =
             Xapi_database.Db_filter_types.(

ocaml/xapi/xapi_host.ml

@@ -2518,7 +2518,7 @@ let sync_pif_currently_attached ~__context ~host ~bridges =
     )
     pifs
 
-let migrate_receive ~__context ~host ~network ~options:_ =
+let migrate_receive ~__context ~host ~network ~options =
   Xapi_vm_migrate.assert_licensed_storage_motion ~__context ;
   let session_id = Context.get_session_id __context in
   let session_rec = Db.Session.get_record ~__context ~self:session_id in