CP-29521: VDI import/export in TAR format

Signed-off-by: Gabor Igloi <[email protected]>

Author: gaborigloi

ocaml/quicktest/quicktest_vdi_ops_data_integrity.ml

@@ -94,6 +94,7 @@ let export_import_vdi rpc session_id ~exportformat sR vdi =
 
 let export_import_raw = export_import_vdi ~exportformat:"raw"
 let export_import_vhd = export_import_vdi ~exportformat:"vhd"
+let export_import_tar = export_import_vdi ~exportformat:"tar"
 
 let f test_case =
   let open Qt_filter in
@@ -117,4 +118,5 @@ let tests () =
   (data_integrity_tests copy_vdi "VDI.copy") @
   (large_data_integrity_tests copy_vdi "VDI.copy") @
   (data_integrity_tests export_import_raw "VDI export/import to/from raw file") @
-  (data_integrity_tests export_import_vhd "VDI export/import to/from VHD file")
+  (data_integrity_tests export_import_vhd "VDI export/import to/from VHD file") @
+  (data_integrity_tests export_import_tar "VDI export/import to/from TAR file")

ocaml/xapi/export_raw_vdi.ml

@@ -36,12 +36,6 @@ let localhost_handler rpc session_id vdi (req: Http.Request.t) (s: Unix.file_des
          debug "export_raw_vdi task_id = %s; vdi = %s; format = %s; content-type = %s; filename = %s"
            (Ref.string_of task_id) (Ref.string_of vdi) (Importexport.Format.to_string format) content_type filename;
          let copy base_path path =
-           let headers = Http.http_200_ok ~keep_alive:false () @ [
-               Http.Hdr.task_id ^ ":" ^ (Ref.string_of task_id);
-               Http.Hdr.content_type ^ ":" ^ content_type;
-               Http.Hdr.content_disposition ^ ": attachment; filename=\"" ^ filename ^ "\""
-             ] in
-           Http_svr.headers s headers;
            try
              debug "Copying VDI contents...";
              Vhd_tool_wrapper.send ?relative_to:base_path (Vhd_tool_wrapper.update_task_progress __context)
@@ -51,14 +45,29 @@ let localhost_handler rpc session_id vdi (req: Http.Request.t) (s: Unix.file_des
              raise (Api_errors.Server_error (Api_errors.vdi_io_error, ["Device I/O errors"])) in
          begin
            try
-             Sm_fs_ops.with_block_attached_device __context rpc session_id vdi `RO
-               (fun path ->
-                  match Importexport.base_vdi_of_req ~__context req with
-                  | Some base_vdi ->
-                    Sm_fs_ops.with_block_attached_device __context rpc session_id base_vdi `RO
-                      (fun base_path -> copy (Some base_path) path)
-                  | None -> copy None path
-               )
+             let headers = Http.http_200_ok ~keep_alive:false () @ [
+                 Http.Hdr.task_id ^ ":" ^ (Ref.string_of task_id);
+                 Http.Hdr.content_type ^ ":" ^ content_type;
+                 Http.Hdr.content_disposition ^ ": attachment; filename=\"" ^ filename ^ "\""
+               ] in
+             Http_svr.headers s headers;
+             match format with
+             | Raw | Vhd ->
+               Sm_fs_ops.with_block_attached_device __context rpc session_id vdi `RO
+                 (fun path ->
+                    match Importexport.base_vdi_of_req ~__context req with
+                    | Some base_vdi ->
+                      Sm_fs_ops.with_block_attached_device __context rpc session_id base_vdi `RO
+                        (fun base_path -> copy (Some base_path) path)
+                    | None -> copy None path
+                 )
+             | Tar ->
+               (* We need to keep refreshing the session to avoid session timeout *)
+               let refresh_session = Xapi_session.consider_touching_session rpc session_id in
+               (* The third element of the tuple, the size, is currently ignored by the function *)
+               let size = Client.Client.VDI.get_virtual_size ~rpc ~session_id ~self:vdi in
+               Stream_vdi.send_all refresh_session s __context rpc session_id [(Xapi_globs.vdi_tar_export_dir, vdi, size)];
+               Tar_unix.write_end s;
            with e ->
              Backtrace.is_important e;
              TaskHelper.failed ~__context e;

ocaml/xapi/import_raw_vdi.ml

@@ -71,17 +71,26 @@ let localhost_handler rpc session_id vdi_opt (req: Request.t) (s: Unix.file_desc
                  error "Not enough info supplied to import";
                  raise (HandleError(Api_errors.Server_error(Api_errors.internal_error, ["Not enough info supplied to import"]),Http.http_400_badrequest ~version:"1.0" ()))
              in
-             let prezeroed = not (Sm_fs_ops.must_write_zeroes_into_new_vdi ~__context vdi) in
-             Sm_fs_ops.with_block_attached_device __context rpc session_id vdi `RW
-               (fun path ->
-                  let headers = Http.http_200_ok ~keep_alive:false () @
-                                [ Http.Hdr.task_id ^ ":" ^ (Ref.string_of task_id);
-                                  content_type ] in
-                  Http_svr.headers s headers;
-                  if chunked
-                  then Vhd_tool_wrapper.receive (Vhd_tool_wrapper.update_task_progress __context) "raw" "chunked" s None path "" prezeroed
-                  else Vhd_tool_wrapper.receive (Vhd_tool_wrapper.update_task_progress __context) (Importexport.Format.to_string format) "none" s req.Request.content_length path "" prezeroed
-               );
+             let headers = Http.http_200_ok ~keep_alive:false () @
+                           [ Http.Hdr.task_id ^ ":" ^ (Ref.string_of task_id);
+                             content_type ] in
+             Http_svr.headers s headers;
+             begin match format with
+               | Raw | Vhd ->
+                 let prezeroed = not (Sm_fs_ops.must_write_zeroes_into_new_vdi ~__context vdi) in
+                 Sm_fs_ops.with_block_attached_device __context rpc session_id vdi `RW
+                   (fun path ->
+                      if chunked
+                      then Vhd_tool_wrapper.receive (Vhd_tool_wrapper.update_task_progress __context) "raw" "chunked" s None path "" prezeroed
+                      else Vhd_tool_wrapper.receive (Vhd_tool_wrapper.update_task_progress __context) (Importexport.Format.to_string format) "none" s req.Request.content_length path "" prezeroed
+                   );
+               | Tar ->
+                 (* We need to keep refreshing the session to avoid session timeout *)
+                 let refresh_session = Xapi_session.consider_touching_session rpc session_id in
+                 let size = Client.VDI.get_virtual_size ~rpc ~session_id ~self:vdi in
+                 (* VDIs exported as TAR archives will always have inline checksums *)
+                 Stream_vdi.recv_all_vdi refresh_session s __context rpc session_id ~has_inline_checksums:true ~force:false [(Xapi_globs.vdi_tar_export_dir, vdi, size)] |> ignore;
+             end;
              TaskHelper.complete ~__context (Some (API.rpc_of_ref_VDI vdi));
              Some vdi
        with

ocaml/xapi/importexport.ml

@@ -322,14 +322,17 @@ module Format = struct
   type t =
     | Raw
     | Vhd
+    | Tar
 
   let to_string = function
     | Raw -> "raw"
     | Vhd -> "vhd"
+    | Tar -> "tar"
 
   let of_string x = match String.lowercase_ascii x with
     | "raw" -> Some Raw
     | "vhd" -> Some Vhd
+    | "tar" -> Some Tar
     | _ -> None
 
   let filename ~__context vdi format =
@@ -340,6 +343,7 @@ module Format = struct
   let content_type = function
     | Raw -> "application/octet-stream"
     | Vhd -> "application/vhd"
+    | Tar -> "application/x-tar"
 
   let _key = "format"
 

ocaml/xapi/stream_vdi.ml

@@ -193,7 +193,7 @@ let verify_inline_checksum ifd checksum_table =
     raise e
 
 (** Receive a set of VDIs split into chunks in a tar format in a defined order *)
-let recv_all refresh_session ifd (__context:Context.t) rpc session_id vsn force prefix_vdis =
+let recv_all_vdi refresh_session ifd (__context:Context.t) rpc session_id ~has_inline_checksums ~force prefix_vdis =
   TaskHelper.set_cancellable ~__context;
 
   let progress = new_progress_record __context prefix_vdis in
@@ -273,7 +273,7 @@ let recv_all refresh_session ifd (__context:Context.t) rpc session_id vsn force
              made_progress __context progress (Int64.add skipped_size length);
 
 
-             if vsn.Importexport.export_vsn > 0 then
+             if has_inline_checksums then
                begin
                  try
                    verify_inline_checksum ifd checksum_table;
@@ -293,6 +293,10 @@ let recv_all refresh_session ifd (__context:Context.t) rpc session_id vsn force
   end;
   !checksum_table
 
+let recv_all refresh_session ifd (__context:Context.t) rpc session_id vsn force =
+  let has_inline_checksums = vsn.Importexport.export_vsn > 0 in
+  recv_all_vdi refresh_session ifd __context rpc session_id ~has_inline_checksums ~force
+
 
 (** Receive a set of VDIs split into chunks in a tar format created out of a Zurich/Geneva
     exported VM. Each chunk has been independently compressed.*)

ocaml/xapi/xapi_globs.ml

@@ -120,6 +120,10 @@ let default_platform_version = "0.0.0"
    and Miami GA (2) [inline checksums, no end-of-tar checksum table] *)
 let export_vsn = 2
 
+(** When exporting a VDI in TAR format, the VDI's data will be stored under
+    this directory in the archive. *)
+let vdi_tar_export_dir = "vdi"
+
 let software_version () =
   (* In the case of XCP, all product_* fields will be blank. *)
   List.filter (fun (_, value) -> value <> "")