Adding image_format to receive_start and receive_start2

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

Author: gthvn1

ocaml/xapi-idl/storage/storage_interface.ml

@@ -251,6 +251,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 = string [@@deriving rpcty]
+
 type sock_path = string [@@deriving rpcty]
 
 type dp_stat_t = {
@@ -277,6 +279,8 @@ type probe_result =
 module Mirror = struct
   type id = string [@@deriving rpcty]
 
+  type image_format = string [@@deriving rpcty]
+
   type state = Receiving | Sending | Copying [@@deriving rpcty]
 
   type t = {source_vdi: Vdi.t; dest_vdi: Vdi.t; state: state list; failed: bool}
@@ -998,6 +1002,8 @@ module StorageAPI (R : RPC) = struct
         )
 
     module MIRROR = struct
+      let image_format_p = Param.mk ~name:"image_format" image_format
+
       let mirror_vm_p = Param.mk ~name:"mirror_vm" Vm.t
 
       let copy_vm_p = Param.mk ~name:"copy_vm" Vm.t
@@ -1009,6 +1015,7 @@ module StorageAPI (R : RPC) = struct
           (dbg_p
           @-> sr_p
           @-> vdi_p
+          @-> image_format_p
           @-> dp_p
           @-> mirror_vm_p
           @-> copy_vm_p
@@ -1034,27 +1041,35 @@ module StorageAPI (R : RPC) = struct
         Use the receive_start2 function instead. 
       *)
       let receive_start =
+        let image_format_p =
+          Param.mk ~name:"image_format" Mirror.image_format
+        in
         let similar_p = Param.mk ~name:"similar" Mirror.similars in
         let result = Param.mk ~name:"result" Mirror.mirror_receive_result in
         declare "DATA.MIRROR.receive_start" []
           (dbg_p
           @-> sr_p
           @-> VDI.vdi_info_p
           @-> id_p
+          @-> image_format_p
           @-> similar_p
           @-> returning result err
           )
 
       (** Called on the receiving end to prepare for receipt of the storage. This
       function should be used in conjunction with [receive_finalize2]*)
       let receive_start2 =
+        let image_format_p =
+          Param.mk ~name:"image_format" Mirror.image_format
+        in
         let similar_p = Param.mk ~name:"similar" Mirror.similars in
         let result = Param.mk ~name:"result" Mirror.mirror_receive_result in
         declare "DATA.MIRROR.receive_start2" []
           (dbg_p
           @-> sr_p
           @-> VDI.vdi_info_p
           @-> id_p
+          @-> image_format_p
           @-> similar_p
           @-> vm_p
           @-> returning result err
@@ -1420,6 +1435,7 @@ module type Server_impl = sig
         -> dbg:debug_info
         -> sr:sr
         -> vdi:vdi
+        -> image_format:string
         -> dp:dp
         -> mirror_vm:vm
         -> copy_vm:vm
@@ -1438,6 +1454,7 @@ module type Server_impl = sig
         -> sr:sr
         -> vdi_info:vdi_info
         -> id:Mirror.id
+        -> image_format:Mirror.image_format
         -> similar:Mirror.similars
         -> Mirror.mirror_receive_result
 
@@ -1447,6 +1464,7 @@ module type Server_impl = sig
         -> sr:sr
         -> vdi_info:vdi_info
         -> id:Mirror.id
+        -> image_format:Mirror.image_format
         -> similar:Mirror.similars
         -> vm:vm
         -> Mirror.mirror_receive_result
@@ -1633,17 +1651,20 @@ module Server (Impl : Server_impl) () = struct
         Impl.DATA.copy () ~dbg ~sr ~vdi ~vm ~url ~dest ~verify_dest
     ) ;
     S.DATA.MIRROR.start
-      (fun dbg sr vdi dp mirror_vm copy_vm url dest verify_dest ->
-        Impl.DATA.MIRROR.start () ~dbg ~sr ~vdi ~dp ~mirror_vm ~copy_vm ~url
-          ~dest ~verify_dest
+      (fun dbg sr vdi image_format dp mirror_vm copy_vm url dest verify_dest ->
+        Impl.DATA.MIRROR.start () ~dbg ~sr ~vdi ~image_format ~dp ~mirror_vm
+          ~copy_vm ~url ~dest ~verify_dest
     ) ;
     S.DATA.MIRROR.stop (fun dbg id -> Impl.DATA.MIRROR.stop () ~dbg ~id) ;
     S.DATA.MIRROR.stat (fun dbg id -> Impl.DATA.MIRROR.stat () ~dbg ~id) ;
-    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_cancel (fun dbg id ->
         Impl.DATA.MIRROR.receive_cancel () ~dbg ~id

ocaml/xapi-idl/storage/storage_skeleton.ml

@@ -157,17 +157,18 @@ module DATA = struct
   module MIRROR = struct
     (** [start task sr vdi url sr2] creates a VDI in remote [url]'s [sr2] and
         writes data synchronously. It returns the id of the VDI.*)
-    let start ctx ~dbg ~sr ~vdi ~dp ~mirror_vm ~copy_vm ~url ~dest =
+    let start ctx ~dbg ~sr ~vdi ~image_format ~dp ~mirror_vm ~copy_vm ~url ~dest
+        =
       u "DATA.MIRROR.start"
 
     let stop ctx ~dbg ~id = u "DATA.MIRROR.stop"
 
     let stat ctx ~dbg ~id = u "DATA.MIRROR.stat"
 
-    let receive_start ctx ~dbg ~sr ~vdi_info ~id ~similar =
+    let receive_start ctx ~dbg ~sr ~vdi_info ~id ~image_format ~similar =
       u "DATA.MIRROR.receive_start"
 
-    let receive_start2 ctx ~dbg ~sr ~vdi_info ~id ~similar ~vm =
+    let receive_start2 ctx ~dbg ~sr ~vdi_info ~id ~image_format ~similar ~vm =
       u "DATA.MIRROR.receive_start2"
 
     let receive_finalize ctx ~dbg ~id = u "DATA.MIRROR.receive_finalize"

ocaml/xapi-storage-cli/main.ml

@@ -322,8 +322,11 @@ let mirror_start common_opts sr vdi dp url dest verify_dest =
       let dp = get_opt dp "Need a local data path" in
       let url = get_opt url "Need a URL" in
       let dest = get_opt dest "Need a destination SR" in
+      (* TODO: add image_format as a parameter of the CLI *)
+      let image_format = "" in
       let task =
-        Client.DATA.MIRROR.start dbg sr vdi dp mirror_vm copy_vm url
+        Client.DATA.MIRROR.start dbg sr vdi image_format dp mirror_vm copy_vm
+          url
           (Storage_interface.Sr.of_string dest)
           verify_dest
       in

ocaml/xapi/storage_migrate.ml

@@ -721,8 +721,8 @@ module MigrateLocal = struct
     | e ->
         raise (Storage_error (Internal_error (Printexc.to_string e)))
 
-  let start ~task ~dbg ~sr ~vdi ~dp ~mirror_vm ~copy_vm ~url ~dest ~verify_dest
-      =
+  let start ~task ~dbg ~sr ~vdi ~image_format ~dp ~mirror_vm ~copy_vm ~url ~dest
+      ~verify_dest =
     SXM.info
       "%s sr:%s vdi:%s dp: %s mirror_vm: %s copy_vm: %s url:%s dest:%s \
        verify_dest:%B"
@@ -786,8 +786,8 @@ module MigrateLocal = struct
            )
         ) ;
       let (Mirror.Vhd_mirror result) =
-        Remote.DATA.MIRROR.receive_start2 dbg dest local_vdi mirror_id similars
-          mirror_vm
+        Remote.DATA.MIRROR.receive_start2 dbg dest local_vdi mirror_id
+          image_format similars mirror_vm
       in
       (* Enable mirroring on the local machine *)
       let mirror_dp = result.Mirror.mirror_datapath in
@@ -1122,7 +1122,7 @@ end
 (** module [MigrateRemote] is similar to [MigrateLocal], but most of these functions
 tend to be executed on the receiver side. *)
 module MigrateRemote = struct
-  let receive_start_common ~dbg ~sr ~vdi_info ~id ~similar ~vm =
+  let receive_start_common ~dbg ~sr ~vdi_info ~id ~image_format ~similar ~vm =
     let on_fail : (unit -> unit) list ref = ref [] in
     let vdis = Local.SR.scan dbg sr in
     (* We drop cbt_metadata VDIs that do not have any actual data *)
@@ -1183,9 +1183,19 @@ module MigrateRemote = struct
                   vdi_info.virtual_size new_size
             ) ;
             vdi_clone
-        | None ->
+        | None -> (
             debug "Creating a blank remote VDI <2>" ;
-            Local.VDI.create dbg sr vdi_info
+            debug "image_format is set to <%s>" image_format ;
+            match image_format with
+            | "" ->
+                Local.VDI.create dbg sr vdi_info
+            | _ ->
+                Local.VDI.create dbg sr
+                  {
+                    vdi_info with
+                    sm_config= ("type", image_format) :: vdi_info.sm_config
+                  }
+          )
       in
       debug "Parent disk content_id=%s" parent.content_id ;
       State.add id
@@ -1221,11 +1231,12 @@ module MigrateRemote = struct
         !on_fail ;
       raise e
 
-  let receive_start ~dbg ~sr ~vdi_info ~id ~similar =
-    receive_start_common ~dbg ~sr ~vdi_info ~id ~similar ~vm:(Vm.of_string "0")
+  let receive_start ~dbg ~sr ~vdi_info ~id ~image_format ~similar =
+    receive_start_common ~dbg ~sr ~vdi_info ~id ~image_format ~similar
+      ~vm:(Vm.of_string "0")
 
-  let receive_start2 ~dbg ~sr ~vdi_info ~id ~similar ~vm =
-    receive_start_common ~dbg ~sr ~vdi_info ~id ~similar ~vm
+  let receive_start2 ~dbg ~sr ~vdi_info ~id ~image_format ~similar ~vm =
+    receive_start_common ~dbg ~sr ~vdi_info ~image_format ~id ~similar ~vm
 
   let receive_finalize ~dbg ~id =
     let recv_state = State.find_active_receive_mirror id in
@@ -1446,10 +1457,11 @@ let copy ~dbg ~sr ~vdi ~vm ~url ~dest ~verify_dest =
         ~dest ~verify_dest
   )
 
-let start ~dbg ~sr ~vdi ~dp ~mirror_vm ~copy_vm ~url ~dest ~verify_dest =
+let start ~dbg ~sr ~vdi ~image_format ~dp ~mirror_vm ~copy_vm ~url ~dest
+    ~verify_dest =
   with_task_and_thread ~dbg (fun task ->
-      MigrateLocal.start ~task ~dbg:dbg.Debug_info.log ~sr ~vdi ~dp ~mirror_vm
-        ~copy_vm ~url ~dest ~verify_dest
+      MigrateLocal.start ~task ~dbg:dbg.Debug_info.log ~sr ~vdi ~image_format
+        ~dp ~mirror_vm ~copy_vm ~url ~dest ~verify_dest
   )
 
 (* XXX: PR-1255: copy the xenopsd 'raise Exception' pattern *)

ocaml/xapi/storage_mux.ml

@@ -836,16 +836,16 @@ module Mux = struct
       with_dbg ~name:"DATA.copy" ~dbg @@ fun dbg -> Storage_migrate.copy ~dbg
 
     module MIRROR = struct
-      let start () ~dbg ~sr ~vdi ~dp ~mirror_vm ~copy_vm ~url ~dest ~verify_dest
-          =
+      let start () ~dbg ~sr ~vdi ~image_format ~dp ~mirror_vm ~copy_vm ~url
+          ~dest ~verify_dest =
         with_dbg ~name:"DATA.MIRROR.start" ~dbg @@ fun di ->
         info
-          "%s dbg:%s sr: %s vdi: %s dp:%s mirror_vm: %s copy_vm: %s url: %s \
-           dest sr: %s verify_dest: %B"
-          __FUNCTION__ dbg (s_of_sr sr) (s_of_vdi vdi) dp (s_of_vm mirror_vm)
-          (s_of_vm copy_vm) url (s_of_sr dest) verify_dest ;
-        Storage_migrate.start ~dbg:di ~sr ~vdi ~dp ~mirror_vm ~copy_vm ~url
-          ~dest ~verify_dest
+          "%s dbg:%s sr: %s vdi: %s image_format: %s dp: %s mirror_vm: %s \
+           copy_vm: %s url: %s dest sr: %s verify_dest: %B"
+          __FUNCTION__ dbg (s_of_sr sr) (s_of_vdi vdi) image_format dp
+          (s_of_vm mirror_vm) (s_of_vm copy_vm) url (s_of_sr dest) verify_dest ;
+        Storage_migrate.start ~dbg:di ~sr ~vdi ~image_format ~dp ~mirror_vm
+          ~copy_vm ~url ~dest ~verify_dest
 
       let stop () ~dbg ~id =
         with_dbg ~name:"DATA.MIRROR.stop" ~dbg @@ fun di ->
@@ -862,26 +862,31 @@ module Mux = struct
         info "%s dbg: %s mirror_id: %s" __FUNCTION__ di.log id ;
         Storage_migrate.stat ~dbg:di.log ~id
 
-      let receive_start () ~dbg ~sr ~vdi_info ~id ~similar =
+      let receive_start () ~dbg ~sr ~vdi_info ~id ~image_format ~similar =
         with_dbg ~name:"DATA.MIRROR.receive_start" ~dbg @@ fun di ->
-        info "%s dbg: %s sr: %s vdi_info: %s mirror_id: %s similar: %s"
+        info
+          "%s dbg: %s sr: %s vdi_info: %s mirror_id: %s image_format: %s \
+           similar: %s"
           __FUNCTION__ dbg (s_of_sr sr)
           (string_of_vdi_info vdi_info)
-          id
+          id image_format
           (String.concat ";" similar) ;
-        Storage_migrate.receive_start ~dbg:di.log ~sr ~vdi_info ~id ~similar
+        Storage_migrate.receive_start ~dbg:di.log ~sr ~vdi_info ~id
+          ~image_format ~similar
 
-      let receive_start2 () ~dbg ~sr ~vdi_info ~id ~similar ~vm =
+      let receive_start2 () ~dbg ~sr ~vdi_info ~id ~image_format ~similar ~vm =
         with_dbg ~name:"DATA.MIRROR.receive_start2" ~dbg @@ fun di ->
-        info "%s dbg: %s sr: %s vdi_info: %s mirror_id: %s similar: %s vm: %s"
+        info
+          "%s dbg: %s sr: %s vdi_info: %s mirror_id: %s image_format: %s \
+           similar: %s vm: %s"
           __FUNCTION__ dbg (s_of_sr sr)
           (string_of_vdi_info vdi_info)
-          id
+          id image_format
           (String.concat ";" similar)
           (s_of_vm vm) ;
         info "%s dbg:%s" __FUNCTION__ dbg ;
-        Storage_migrate.receive_start2 ~dbg:di.log ~sr ~vdi_info ~id ~similar
-          ~vm
+        Storage_migrate.receive_start2 ~dbg:di.log ~sr ~vdi_info ~id
+          ~image_format ~similar ~vm
 
       let receive_finalize () ~dbg ~id =
         with_dbg ~name:"DATA.MIRROR.receive_finalize" ~dbg @@ fun di ->

ocaml/xapi/storage_smapiv1.ml

@@ -1213,8 +1213,8 @@ module SMAPIv1 : Server_impl = struct
       assert false
 
     module MIRROR = struct
-      let start _context ~dbg:_ ~sr:_ ~vdi:_ ~dp:_ ~mirror_vm:_ ~copy_vm:_
-          ~url:_ ~dest:_ ~verify_dest:_ =
+      let start _context ~dbg:_ ~sr:_ ~vdi:_ ~image_format:_ ~dp:_ ~mirror_vm:_
+          ~copy_vm:_ ~url:_ ~dest:_ ~verify_dest:_ =
         assert false
 
       let stop _context ~dbg:_ ~id:_ = assert false
@@ -1223,11 +1223,12 @@ module SMAPIv1 : Server_impl = struct
 
       let stat _context ~dbg:_ ~id:_ = assert false
 
-      let receive_start _context ~dbg:_ ~sr:_ ~vdi_info:_ ~id:_ ~similar:_ =
+      let receive_start _context ~dbg:_ ~sr:_ ~vdi_info:_ ~id:_ ~image_format:_
+          ~similar:_ =
         assert false
 
-      let receive_start2 _context ~dbg:_ ~sr:_ ~vdi_info:_ ~id:_ ~similar:_
-          ~vm:_ =
+      let receive_start2 _context ~dbg:_ ~sr:_ ~vdi_info:_ ~id:_ ~image_format:_
+          ~similar:_ ~vm:_ =
         assert false
 
       let receive_finalize _context ~dbg:_ ~id:_ = assert false

ocaml/xapi/storage_smapiv1_wrapper.ml

@@ -1143,11 +1143,14 @@ functor
         Impl.DATA.copy context ~dbg ~sr ~vdi ~vm ~url ~dest
 
       module MIRROR = struct
-        let start context ~dbg ~sr ~vdi ~dp ~mirror_vm ~copy_vm ~url ~dest =
-          info "DATA.MIRROR.start dbg:%s sr:%s vdi:%s url:%s dest:%s" dbg
-            (s_of_sr sr) (s_of_vdi vdi) url (s_of_sr dest) ;
-          Impl.DATA.MIRROR.start context ~dbg ~sr ~vdi ~dp ~mirror_vm ~copy_vm
-            ~url ~dest
+        let start context ~dbg ~sr ~vdi ~image_format ~dp ~mirror_vm ~copy_vm
+            ~url ~dest =
+          info
+            "DATA.MIRROR.start dbg:%s sr:%s vdi:%s image_format:%s url:%s \
+             dest:%s"
+            dbg (s_of_sr sr) (s_of_vdi vdi) image_format url (s_of_sr dest) ;
+          Impl.DATA.MIRROR.start context ~dbg ~sr ~vdi ~image_format ~dp
+            ~mirror_vm ~copy_vm ~url ~dest
 
         let stop context ~dbg ~id =
           info "DATA.MIRROR.stop dbg:%s id:%s" dbg id ;
@@ -1161,20 +1164,26 @@ functor
           info "DATA.MIRROR.stat dbg:%s id:%s" dbg id ;
           Impl.DATA.MIRROR.stat context ~dbg ~id
 
-        let receive_start context ~dbg ~sr ~vdi_info ~id ~similar =
-          info "DATA.MIRROR.receive_start dbg:%s sr:%s id:%s similar:[%s]" dbg
-            (s_of_sr sr) id
+        let receive_start context ~dbg ~sr ~vdi_info ~id ~image_format ~similar
+            =
+          info
+            "DATA.MIRROR.receive_start dbg:%s sr:%s id:%s image_format:%s \
+             similar:[%s]"
+            dbg (s_of_sr sr) id image_format
             (String.concat "," similar) ;
-          Impl.DATA.MIRROR.receive_start context ~dbg ~sr ~vdi_info ~id ~similar
+          Impl.DATA.MIRROR.receive_start context ~dbg ~sr ~vdi_info ~id
+            ~image_format ~similar
 
-        let receive_start2 context ~dbg ~sr ~vdi_info ~id ~similar ~vm =
+        let receive_start2 context ~dbg ~sr ~vdi_info ~id ~image_format ~similar
+            ~vm =
           info
-            "DATA.MIRROR.receive_start2 dbg:%s sr:%s id:%s similar:[%s] vm:%s"
-            dbg (s_of_sr sr) id
+            "DATA.MIRROR.receive_start2 dbg:%s sr:%s id:%s image_format:%s \
+             similar:[%s] vm:%s"
+            dbg (s_of_sr sr) id image_format
             (String.concat "," similar)
             (s_of_vm vm) ;
           Impl.DATA.MIRROR.receive_start2 context ~dbg ~sr ~vdi_info ~id
-            ~similar ~vm
+            ~image_format ~similar ~vm
 
         let receive_finalize context ~dbg ~id =
           info "DATA.MIRROR.receive_finalize dbg:%s id:%s" dbg id ;