|
[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 _______________________________________________ xen-api mailing list xen-api@xxxxxxxxxxxxxxxxxxx http://lists.xensource.com/mailman/listinfo/xen-api
|
 |
Lists.xenproject.org is hosted with RackSpace, monitoring our |