[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Xen-API] [PATCH] add optional compression to VM exports



# HG changeset patch
# User David Scott <dave.scott@xxxxxxxxxxxxx>
# Date 1279121801 -3600
# Node ID aeb326b8d2d1bb5ff897ffb249ec2dbdaa1c5783
# Parent  a9d00d9121a37d036aacc0defa09d490d0fc6191
Add optional compression to VM exports. Both compressed and uncompressed 
formats can be imported as normal since the format is auto-detected.

Design notes on the wiki: 
http://wiki.xensource.com/xenwiki/Compressing_VM_exports

Signed-off-by: David Scott <dave.scott@xxxxxxxxxxxxx>

diff -r a9d00d9121a3 -r aeb326b8d2d1 ocaml/idl/constants.ml
--- a/ocaml/idl/constants.ml    Mon Jul 12 08:32:58 2010 +0100
+++ b/ocaml/idl/constants.ml    Wed Jul 14 16:36:41 2010 +0100
@@ -47,6 +47,8 @@
 let wlb_diagnostics_uri = "/wlb_diagnostics"          (* 
ocaml/xapi/wlb_reports.ml *)
 let audit_log_uri = "/audit_log"                      (* ocaml/xapi/audit.ml *)
 
+let use_compression = "use_compression"
+
 (* If VM.HVM_boot_policy is set to this then we boot using qemu-dm *)
 let hvm_boot_policy_bios_order = "BIOS order"
 (* Key we expect to find in VM.HVM_boot_params if VM.HVM_boot_policy = 
BIOS_order.
diff -r a9d00d9121a3 -r aeb326b8d2d1 ocaml/xapi/cli_frontend.ml
--- a/ocaml/xapi/cli_frontend.ml        Mon Jul 12 08:32:58 2010 +0100
+++ b/ocaml/xapi/cli_frontend.ml        Wed Jul 14 16:36:41 2010 +0100
@@ -1231,7 +1231,7 @@
    "vm-export",
     {
       reqd=["filename"];
-      optn=["preserve-power-state"];
+      optn=["preserve-power-state"; "compress"];
       help="Export a VM to <filename>.";
       implementation= With_fd Cli_operations.vm_export;
       flags=[Standard; Vm_selectors];
diff -r a9d00d9121a3 -r aeb326b8d2d1 ocaml/xapi/cli_operations.ml
--- a/ocaml/xapi/cli_operations.ml      Mon Jul 12 08:32:58 2010 +0100
+++ b/ocaml/xapi/cli_operations.ml      Wed Jul 14 16:36:41 2010 +0100
@@ -3067,7 +3067,7 @@
     raise (Cli_util.Cli_failure "Need one of: vm-uuid, host-uuid, 
network-uuid, sr-uuid or pool-uuid")
 
     
-let export_common fd printer rpc session_id params filename num 
preserve_power_state vm =
+let export_common fd printer rpc session_id params filename num 
use_compression preserve_power_state vm =
   let vm_record = vm.record () in
   let exporttask = Client.Task.create rpc session_id (Printf.sprintf "Export 
of VM: %s" (vm_record.API.vM_uuid)) "" in
   
@@ -3082,13 +3082,15 @@
       let f = if !num > 1 then filename ^ (string_of_int !num) else filename in
       download_file ~__context rpc session_id exporttask fd f
         (Printf.sprintf
-           "%s?session_id=%s&task_id=%s&ref=%s&preserve_power_state=%b" 
+           "%s?session_id=%s&task_id=%s&ref=%s&%s=%s&preserve_power_state=%b" 
           (if List.mem_assoc "metadata" params
            then Constants.export_metadata_uri
            else Constants.export_uri)
           (Ref.string_of session_id)
            (Ref.string_of exporttask) 
           (Ref.string_of (vm.getref ()))
+          Constants.use_compression
+          (if use_compression then "true" else "false")
                preserve_power_state)
         "Export";
         num := !num + 1)
@@ -3096,20 +3098,22 @@
     
 let vm_export fd printer rpc session_id params =
   let filename = List.assoc "filename" params in
+  let use_compression = List.mem_assoc "compress" params && (List.assoc 
"compress" params = "true") in
   let preserve_power_state = List.mem_assoc "preserve-power-state" params && 
bool_of_string "preserve-power-state" (List.assoc "preserve-power-state" 
params) in
   let num = ref 1 in
   let op vm = 
-    export_common fd printer rpc session_id params filename num 
preserve_power_state vm
+    export_common fd printer rpc session_id params filename num 
use_compression preserve_power_state vm
   in
-  ignore(do_vm_op printer rpc session_id op params ["filename"; "metadata"; 
"preserve-power-state"])
+  ignore(do_vm_op printer rpc session_id op params ["filename"; "metadata"; 
"compress"; "preserve-power-state"])
 
 let vm_export_aux obj_type fd printer rpc session_id params =
   let filename = List.assoc "filename" params in
+  let use_compression = List.mem_assoc "compress" params && (List.assoc 
"compress" params = "true") in
   let preserve_power_state = List.mem_assoc "preserve-power-state" params && 
bool_of_string "preserve-power-state" (List.assoc "preserve-power-state" 
params) in
   let num = ref 1 in
   let uuid = List.assoc (obj_type ^ "-uuid") params in
   let ref = Client.VM.get_by_uuid rpc session_id uuid in
-  export_common fd printer rpc session_id params filename num 
preserve_power_state (vm_record rpc session_id ref)
+  export_common fd printer rpc session_id params filename num use_compression 
preserve_power_state (vm_record rpc session_id ref)
 
 let vm_copy_bios_strings printer rpc session_id params =
   let host = Client.Host.get_by_uuid rpc session_id (List.assoc "host-uuid" 
params) in
diff -r a9d00d9121a3 -r aeb326b8d2d1 ocaml/xapi/export.ml
--- a/ocaml/xapi/export.ml      Mon Jul 12 08:32:58 2010 +0100
+++ b/ocaml/xapi/export.ml      Wed Jul 14 16:36:41 2010 +0100
@@ -419,6 +419,8 @@
   
   Xapi_http.assert_credentials_ok "VM.export" ~http_action:"get_export" req;
     
+  let use_compression = List.mem_assoc Constants.use_compression req.query && 
List.assoc Constants.use_compression req.query = "true" in
+  debug "Using compression: %b" use_compression;
   (* Perform the SR reachability check using a fresh context/task because
      we don't want to complete the task in the forwarding case *)
   
@@ -485,7 +487,11 @@
               with_vm_locked ~__context ~vm:vm_ref ~task_id `export
                 (fun () -> 
                    Http_svr.headers s headers;
-                   export refresh_session __context rpc session_id s vm_ref 
preserve_power_state)
+                   let go fd = export refresh_session __context rpc session_id 
fd vm_ref preserve_power_state in
+                   if use_compression
+                   then Gzip.compress s go
+                   else go s
+                )
                 
                     (* Exceptions are handled by Server_helpers.with_context *)
             ))
diff -r a9d00d9121a3 -r aeb326b8d2d1 ocaml/xapi/import.ml
--- a/ocaml/xapi/import.ml      Mon Jul 12 08:32:58 2010 +0100
+++ b/ocaml/xapi/import.ml      Wed Jul 14 16:36:41 2010 +0100
@@ -576,17 +576,66 @@
     end;
     raise e
 
-(** Read the next file from the tar stream as XML metadata *)
-let get_xml fd filename =
-  (* Read the xml header *)
-  let xml = Tar.Archive.with_next_file fd
-    (fun s hdr ->
-       if hdr.Tar.Header.file_name <> filename then raise (IFailure 
(Unexpected_file (filename, hdr.Tar.Header.file_name)));
-       let file_size = hdr.Tar.Header.file_size in
-       let xml_string = Bigbuffer.make () in
-       really_read_bigbuffer s xml_string file_size;
-       xml_string) in
-  Xml.parse_bigbuffer xml
+(** Read the next file in the archive as xml *)
+let read_xml hdr fd = 
+  let xml_string = Bigbuffer.make () in
+  really_read_bigbuffer fd xml_string hdr.Tar.Header.file_size;
+  Xml.parse_bigbuffer xml_string
+
+let assert_filename_is hdr filename = 
+  if hdr.Tar.Header.file_name <> filename then begin
+    let hex = Tar.Header.to_hex in
+    error "import expects the next file in the stream to be [%s]; got [%s]"
+      (hex  hdr.Tar.Header.file_name) (hex Xva.xml_filename);
+    raise (IFailure (Unexpected_file(hdr.Tar.Header.file_name, 
Xva.xml_filename)))
+  end
+
+(** Takes an fd and a function, tries first to read the first tar block
+    and checks for the existence of 'ova.xml'. If that fails then pipe
+    the lot through gzip and try again *)
+let with_open_archive fd f = 
+  (* Read the first header's worth into a buffer *)
+  let buffer = String.make Tar.Header.length ' ' in
+  let retry_with_gzip = ref true in
+  try
+    really_read fd buffer 0 Tar.Header.length;
+
+    (* we assume the first block is not all zeroes *)
+    let Some hdr = Tar.Header.unmarshal buffer in
+    assert_filename_is hdr Xva.xml_filename;
+
+    (* successfully opened uncompressed stream *)
+    retry_with_gzip := false;
+    let xml = read_xml hdr fd in
+    Tar.Archive.skip fd (Tar.Header.compute_zero_padding_length hdr);
+    f xml fd
+  with e ->
+    if not(!retry_with_gzip) then raise e;
+    debug "Failed to directly open the archive; trying gzip";
+    let pipe_out, pipe_in = Unix.pipe () in
+    let t = Thread.create
+      (Gzip.decompress pipe_in)
+      (fun compressed_in ->
+        (* Write the initial buffer *)
+        Unix.set_close_on_exec compressed_in;
+        debug "Writing initial buffer";
+        Unix.write compressed_in buffer 0 Tar.Header.length;
+        let n = Unixext.copy_file fd compressed_in in
+        debug "Written a total of %d + %Ld bytes" Tar.Header.length n;
+      ) in
+    finally
+      (fun () ->
+        let hdr = Tar.Header.get_next_header pipe_out in
+        assert_filename_is hdr Xva.xml_filename;
+
+        let xml = read_xml hdr pipe_out in
+        Tar.Archive.skip pipe_out (Tar.Header.compute_zero_padding_length hdr);
+        f xml pipe_out)
+      (fun () ->
+        debug "Closing pipes";
+        Unix.close pipe_in;
+        Unix.close pipe_out;
+        Thread.join t)
 
 (** Remove "import" from the current operations of all created VMs, complete 
the
     task including the VM references *)
@@ -622,7 +671,9 @@
         [ Http.task_id_hdr ^ ":" ^ (Ref.string_of (Context.get_task_id 
__context));
           content_type ] in
        Http_svr.headers s headers;
-       let metadata = get_xml s Xva.xml_filename in
+       with_open_archive s
+       (fun metadata s ->
+           debug "Got XML";
        (* Skip trailing two zero blocks *)
        Tar.Archive.skip s (Tar.Header.length * 2);
 
@@ -651,7 +702,7 @@
         cleanup on_cleanup_stack;
         end;
         raise e
-    ))
+    )))
 
 let handler (req: request) s = 
   req.close <- true;
@@ -730,8 +781,9 @@
                        content_type ] in
                    Http_svr.headers s headers;
                    debug "Reading XML";
-                   let metadata = get_xml s Xva.xml_filename in
-                   debug "Got XML";
+                   with_open_archive s
+                     (fun metadata s ->
+                        debug "Got XML";
                    let old_zurich_or_geneva = try ignore(Xva.of_xml metadata); 
true with _ -> false in
                    let vmrefs = 
                      if old_zurich_or_geneva 
@@ -769,7 +821,8 @@
                          (* against the table here. Nb. Rio GA-Miami B2 
exports get their checksums checked twice! *)
                          if header.version.export_vsn < 2 then 
                            begin
-                             let expected_checksums = checksum_table_of_xmlrpc 
(get_xml s Xva.checksum_filename) in
+                             let xml = Tar.Archive.with_next_file s (fun s hdr 
-> read_xml hdr s) in
+                             let expected_checksums = checksum_table_of_xmlrpc 
xml in
                              if not(compare_checksums checksum_table 
expected_checksums) then begin
                                error "Some data checksums were incorrect: VM 
may be corrupt";
                                if not(force)
@@ -793,6 +846,7 @@
                    in
                    complete_import ~__context vmrefs;
                    debug "import successful"
+                   )
              with 
                | IFailure failure ->
                    begin
 ocaml/idl/constants.ml       |   2 +
 ocaml/xapi/cli_frontend.ml   |   2 +-
 ocaml/xapi/cli_operations.ml |  14 ++++--
 ocaml/xapi/export.ml         |   8 +++-
 ocaml/xapi/import.ml         |  86 +++++++++++++++++++++++++++++++++++--------
 5 files changed, 89 insertions(+), 23 deletions(-)


Attachment: add-compression.patch
Description: Text Data

_______________________________________________
xen-api mailing list
xen-api@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/mailman/listinfo/xen-api

 


Rackspace

Lists.xenproject.org is hosted with RackSpace, monitoring our
servers 24x7x365 and backed by RackSpace's Fanatical Support®.