# HG changeset patch # User Jonathan Knowles <[email protected]> # Date 1269859679 -3600 # Node ID 56f91be468e5704a0d7b0e7b7c5e2481b46aa12f # Parent b0007031d47aacbd4f4afd0f0e9d00b8e7ca99df [CA-39589] Fixes confusing code structure, which made it hard to discern the true execution path through a relatively long and deeply nested function.
Signed-off-by: Jonathan Knowles <[email protected]> Acked-by: Marcus Granado <[email protected]> diff -r b0007031d47a -r 56f91be468e5 ocaml/xapi/vmops.ml --- a/ocaml/xapi/vmops.ml Mon Mar 29 11:47:58 2010 +0100 +++ b/ocaml/xapi/vmops.ml Mon Mar 29 11:47:59 2010 +0100 @@ -891,95 +891,82 @@ exception Domain_architecture_not_supported_in_suspend let suspend ~live ~progress_cb ~__context ~xc ~xs ~vm = - let uuid = Db.VM.get_uuid ~__context ~self:vm in - let hvm = Helpers.has_booted_hvm ~__context ~self:vm in - let domid = Helpers.domid_of_vm ~__context ~self:vm in - - Xapi_xenops_errors.handle_xenops_error - (fun () -> - with_xc_and_xs - (fun xc xs -> - let is_paused = Db.VM.get_power_state - ~__context ~self:vm = `Paused in + let uuid = Db.VM.get_uuid ~__context ~self:vm in + let hvm = Helpers.has_booted_hvm ~__context ~self:vm in + let domid = Helpers.domid_of_vm ~__context ~self:vm in + Xapi_xenops_errors.handle_xenops_error + (fun () -> + with_xc_and_xs + (fun xc xs -> + let is_paused = Db.VM.get_power_state ~__context ~self:vm = `Paused in if is_paused then Domain.unpause ~xc domid; let min = Db.VM.get_memory_dynamic_min ~__context ~self:vm in let max = Db.VM.get_memory_dynamic_max ~__context ~self:vm in let min = Int64.to_int (Int64.div min 1024L) in let max = Int64.to_int (Int64.div max 1024L) in try - (* Balloon down the guest as far as we can to force it to clear - unnecessary caches etc. *) + (* Balloon down the guest as far as we can to force it to clear unnecessary caches etc. *) debug "suspend phase 0/4: asking guest to balloon down"; Domain.set_memory_dynamic_range ~xs ~min ~max:min domid; Memory_control.balance_memory ~__context ~xc ~xs; - debug "suspend phase 1/4: hot-unplugging any PCI devices"; let hvm = (Xc.domain_getinfo xc domid).Xc.hvm_guest in if hvm then unplug_pcidevs_noexn ~__context ~vm domid (Device.PCI.list xc xs domid); - - - let suspend_SR = Helpers.choose_suspend_sr ~__context ~vm in - let required_space = get_suspend_space __context vm in - Sm_fs_ops.with_new_fs_vdi __context - ~name_label:"Suspend image" ~name_description:"Suspend image" - ~sR:suspend_SR ~_type:`suspend ~required_space - ~sm_config:[Xapi_globs._sm_vm_hint, uuid] - (fun vdi_ref mount_point -> - let filename = sprintf "%s/suspend-image" mount_point in - debug "suspend: phase 2/4: opening suspend image file (%s)" - filename; - (* NB if the suspend file already exists it will be *) - (* overwritten. *) - let fd = Unix.openfile filename - [ Unix.O_WRONLY; Unix.O_CREAT ] 0o600 in - finally - (fun () -> - let domid = Helpers.domid_of_vm ~__context ~self:vm in - debug "suspend: phase 3/4: suspending to disk"; - with_xal - (fun xal -> - Domain.suspend ~xc ~xs ~hvm domid fd [] - ~progress_callback:progress_cb - (fun () -> - match clean_shutdown_with_reason ~xal - ~__context ~self:vm domid - Domain.Suspend with - | Xal.Suspended -> () (* good *) - | Xal.Crashed -> - raise (Api_errors.Server_error(Api_errors.vm_crashed, [ Ref.string_of vm ])) - | Xal.Rebooted -> - raise (Api_errors.Server_error(Api_errors.vm_rebooted, [ Ref.string_of vm ])) - | Xal.Halted - | Xal.Vanished -> - raise (Api_errors.Server_error(Api_errors.vm_halted, [ Ref.string_of vm ])) - | Xal.Shutdown x -> - failwith (Printf.sprintf "Expected domain shutdown reason: %d" x) - ) - ); - (* If the suspend succeeds, set the suspend_VDI *) - Db.VM.set_suspend_VDI ~__context ~self:vm - ~value:vdi_ref; - ) - (fun () -> Unix.close fd); - debug "suspend: complete"); - - debug "suspend phase 4/4: recording memory usage"; - (* Record the final memory usage of the VM, so *) - (* that we know how much memory to free before *) - (* attempting to resume this VM in future. *) - let di = with_xc (fun xc -> Xc.domain_getinfo xc domid) in - let final_memory_bytes = Memory.bytes_of_pages (Int64.of_nativeint di.Xc.total_memory_pages) in - debug "total_memory_pages=%Ld; storing target=%Ld" (Int64.of_nativeint di.Xc.total_memory_pages) final_memory_bytes; - (* CA-31759: avoid using the LBR to simplify upgrade *) - Db.VM.set_memory_target ~__context ~self:vm ~value:final_memory_bytes; - - with e -> - Domain.set_memory_dynamic_range ~xs ~min ~max domid; - Memory_control.balance_memory ~__context ~xc ~xs; - if is_paused then - (try Domain.pause ~xc domid with _ -> ()); - raise e - )) + let suspend_SR = Helpers.choose_suspend_sr ~__context ~vm in + let required_space = get_suspend_space __context vm in + Sm_fs_ops.with_new_fs_vdi __context + ~name_label:"Suspend image" ~name_description:"Suspend image" + ~sR:suspend_SR ~_type:`suspend ~required_space + ~sm_config:[Xapi_globs._sm_vm_hint, uuid] + (fun vdi_ref mount_point -> + let filename = sprintf "%s/suspend-image" mount_point in + debug "suspend: phase 2/4: opening suspend image file (%s)" + filename; + (* NB if the suspend file already exists it will be *) + (* overwritten. *) + let fd = Unix.openfile filename + [ Unix.O_WRONLY; Unix.O_CREAT ] 0o600 in + finally + (fun () -> + let domid = Helpers.domid_of_vm ~__context ~self:vm in + debug "suspend: phase 3/4: suspending to disk"; + with_xal + (fun xal -> + Domain.suspend ~xc ~xs ~hvm domid fd [] + ~progress_callback:progress_cb + (fun () -> + match clean_shutdown_with_reason ~xal + ~__context ~self:vm domid + Domain.Suspend with + | Xal.Suspended -> () (* good *) + | Xal.Crashed -> + raise (Api_errors.Server_error(Api_errors.vm_crashed, [ Ref.string_of vm ])) + | Xal.Rebooted -> + raise (Api_errors.Server_error(Api_errors.vm_rebooted, [ Ref.string_of vm ])) + | Xal.Halted + | Xal.Vanished -> + raise (Api_errors.Server_error(Api_errors.vm_halted, [ Ref.string_of vm ])) + | Xal.Shutdown x -> + failwith (Printf.sprintf "Expected domain shutdown reason: %d" x))); + (* If the suspend succeeds, set the suspend_VDI *) + Db.VM.set_suspend_VDI ~__context ~self:vm ~value:vdi_ref;) + (fun () -> Unix.close fd); + debug "suspend: complete"); + debug "suspend phase 4/4: recording memory usage"; + (* Record the final memory usage of the VM, so *) + (* that we know how much memory to free before *) + (* attempting to resume this VM in future. *) + let di = with_xc (fun xc -> Xc.domain_getinfo xc domid) in + let final_memory_bytes = Memory.bytes_of_pages (Int64.of_nativeint di.Xc.total_memory_pages) in + debug "total_memory_pages=%Ld; storing target=%Ld" (Int64.of_nativeint di.Xc.total_memory_pages) final_memory_bytes; + (* CA-31759: avoid using the LBR to simplify upgrade *) + Db.VM.set_memory_target ~__context ~self:vm ~value:final_memory_bytes; + with e -> + Domain.set_memory_dynamic_range ~xs ~min ~max domid; + Memory_control.balance_memory ~__context ~xc ~xs; + if is_paused then + (try Domain.pause ~xc domid with _ -> ()); + raise e)) let resume ~__context ~xc ~xs ~vm = let domid = Helpers.domid_of_vm ~__context ~self:vm in 1 file changed, 64 insertions(+), 77 deletions(-) ocaml/xapi/vmops.ml | 141 +++++++++++++++++++++++----------------------------
# HG changeset patch # User Jonathan Knowles <[email protected]> # Date 1269859679 -3600 # Node ID 56f91be468e5704a0d7b0e7b7c5e2481b46aa12f # Parent b0007031d47aacbd4f4afd0f0e9d00b8e7ca99df [CA-39589] Fixes confusing code structure, which made it hard to discern the true execution path through a relatively long and deeply nested function. Signed-off-by: Jonathan Knowles <[email protected]> Acked-by: Marcus Granado <[email protected]> diff -r b0007031d47a -r 56f91be468e5 ocaml/xapi/vmops.ml --- a/ocaml/xapi/vmops.ml Mon Mar 29 11:47:58 2010 +0100 +++ b/ocaml/xapi/vmops.ml Mon Mar 29 11:47:59 2010 +0100 @@ -891,95 +891,82 @@ exception Domain_architecture_not_supported_in_suspend let suspend ~live ~progress_cb ~__context ~xc ~xs ~vm = - let uuid = Db.VM.get_uuid ~__context ~self:vm in - let hvm = Helpers.has_booted_hvm ~__context ~self:vm in - let domid = Helpers.domid_of_vm ~__context ~self:vm in - - Xapi_xenops_errors.handle_xenops_error - (fun () -> - with_xc_and_xs - (fun xc xs -> - let is_paused = Db.VM.get_power_state - ~__context ~self:vm = `Paused in + let uuid = Db.VM.get_uuid ~__context ~self:vm in + let hvm = Helpers.has_booted_hvm ~__context ~self:vm in + let domid = Helpers.domid_of_vm ~__context ~self:vm in + Xapi_xenops_errors.handle_xenops_error + (fun () -> + with_xc_and_xs + (fun xc xs -> + let is_paused = Db.VM.get_power_state ~__context ~self:vm = `Paused in if is_paused then Domain.unpause ~xc domid; let min = Db.VM.get_memory_dynamic_min ~__context ~self:vm in let max = Db.VM.get_memory_dynamic_max ~__context ~self:vm in let min = Int64.to_int (Int64.div min 1024L) in let max = Int64.to_int (Int64.div max 1024L) in try - (* Balloon down the guest as far as we can to force it to clear - unnecessary caches etc. *) + (* Balloon down the guest as far as we can to force it to clear unnecessary caches etc. *) debug "suspend phase 0/4: asking guest to balloon down"; Domain.set_memory_dynamic_range ~xs ~min ~max:min domid; Memory_control.balance_memory ~__context ~xc ~xs; - debug "suspend phase 1/4: hot-unplugging any PCI devices"; let hvm = (Xc.domain_getinfo xc domid).Xc.hvm_guest in if hvm then unplug_pcidevs_noexn ~__context ~vm domid (Device.PCI.list xc xs domid); - - - let suspend_SR = Helpers.choose_suspend_sr ~__context ~vm in - let required_space = get_suspend_space __context vm in - Sm_fs_ops.with_new_fs_vdi __context - ~name_label:"Suspend image" ~name_description:"Suspend image" - ~sR:suspend_SR ~_type:`suspend ~required_space - ~sm_config:[Xapi_globs._sm_vm_hint, uuid] - (fun vdi_ref mount_point -> - let filename = sprintf "%s/suspend-image" mount_point in - debug "suspend: phase 2/4: opening suspend image file (%s)" - filename; - (* NB if the suspend file already exists it will be *) - (* overwritten. *) - let fd = Unix.openfile filename - [ Unix.O_WRONLY; Unix.O_CREAT ] 0o600 in - finally - (fun () -> - let domid = Helpers.domid_of_vm ~__context ~self:vm in - debug "suspend: phase 3/4: suspending to disk"; - with_xal - (fun xal -> - Domain.suspend ~xc ~xs ~hvm domid fd [] - ~progress_callback:progress_cb - (fun () -> - match clean_shutdown_with_reason ~xal - ~__context ~self:vm domid - Domain.Suspend with - | Xal.Suspended -> () (* good *) - | Xal.Crashed -> - raise (Api_errors.Server_error(Api_errors.vm_crashed, [ Ref.string_of vm ])) - | Xal.Rebooted -> - raise (Api_errors.Server_error(Api_errors.vm_rebooted, [ Ref.string_of vm ])) - | Xal.Halted - | Xal.Vanished -> - raise (Api_errors.Server_error(Api_errors.vm_halted, [ Ref.string_of vm ])) - | Xal.Shutdown x -> - failwith (Printf.sprintf "Expected domain shutdown reason: %d" x) - ) - ); - (* If the suspend succeeds, set the suspend_VDI *) - Db.VM.set_suspend_VDI ~__context ~self:vm - ~value:vdi_ref; - ) - (fun () -> Unix.close fd); - debug "suspend: complete"); - - debug "suspend phase 4/4: recording memory usage"; - (* Record the final memory usage of the VM, so *) - (* that we know how much memory to free before *) - (* attempting to resume this VM in future. *) - let di = with_xc (fun xc -> Xc.domain_getinfo xc domid) in - let final_memory_bytes = Memory.bytes_of_pages (Int64.of_nativeint di.Xc.total_memory_pages) in - debug "total_memory_pages=%Ld; storing target=%Ld" (Int64.of_nativeint di.Xc.total_memory_pages) final_memory_bytes; - (* CA-31759: avoid using the LBR to simplify upgrade *) - Db.VM.set_memory_target ~__context ~self:vm ~value:final_memory_bytes; - - with e -> - Domain.set_memory_dynamic_range ~xs ~min ~max domid; - Memory_control.balance_memory ~__context ~xc ~xs; - if is_paused then - (try Domain.pause ~xc domid with _ -> ()); - raise e - )) + let suspend_SR = Helpers.choose_suspend_sr ~__context ~vm in + let required_space = get_suspend_space __context vm in + Sm_fs_ops.with_new_fs_vdi __context + ~name_label:"Suspend image" ~name_description:"Suspend image" + ~sR:suspend_SR ~_type:`suspend ~required_space + ~sm_config:[Xapi_globs._sm_vm_hint, uuid] + (fun vdi_ref mount_point -> + let filename = sprintf "%s/suspend-image" mount_point in + debug "suspend: phase 2/4: opening suspend image file (%s)" + filename; + (* NB if the suspend file already exists it will be *) + (* overwritten. *) + let fd = Unix.openfile filename + [ Unix.O_WRONLY; Unix.O_CREAT ] 0o600 in + finally + (fun () -> + let domid = Helpers.domid_of_vm ~__context ~self:vm in + debug "suspend: phase 3/4: suspending to disk"; + with_xal + (fun xal -> + Domain.suspend ~xc ~xs ~hvm domid fd [] + ~progress_callback:progress_cb + (fun () -> + match clean_shutdown_with_reason ~xal + ~__context ~self:vm domid + Domain.Suspend with + | Xal.Suspended -> () (* good *) + | Xal.Crashed -> + raise (Api_errors.Server_error(Api_errors.vm_crashed, [ Ref.string_of vm ])) + | Xal.Rebooted -> + raise (Api_errors.Server_error(Api_errors.vm_rebooted, [ Ref.string_of vm ])) + | Xal.Halted + | Xal.Vanished -> + raise (Api_errors.Server_error(Api_errors.vm_halted, [ Ref.string_of vm ])) + | Xal.Shutdown x -> + failwith (Printf.sprintf "Expected domain shutdown reason: %d" x))); + (* If the suspend succeeds, set the suspend_VDI *) + Db.VM.set_suspend_VDI ~__context ~self:vm ~value:vdi_ref;) + (fun () -> Unix.close fd); + debug "suspend: complete"); + debug "suspend phase 4/4: recording memory usage"; + (* Record the final memory usage of the VM, so *) + (* that we know how much memory to free before *) + (* attempting to resume this VM in future. *) + let di = with_xc (fun xc -> Xc.domain_getinfo xc domid) in + let final_memory_bytes = Memory.bytes_of_pages (Int64.of_nativeint di.Xc.total_memory_pages) in + debug "total_memory_pages=%Ld; storing target=%Ld" (Int64.of_nativeint di.Xc.total_memory_pages) final_memory_bytes; + (* CA-31759: avoid using the LBR to simplify upgrade *) + Db.VM.set_memory_target ~__context ~self:vm ~value:final_memory_bytes; + with e -> + Domain.set_memory_dynamic_range ~xs ~min ~max domid; + Memory_control.balance_memory ~__context ~xc ~xs; + if is_paused then + (try Domain.pause ~xc domid with _ -> ()); + raise e)) let resume ~__context ~xc ~xs ~vm = let domid = Helpers.domid_of_vm ~__context ~self:vm in
_______________________________________________ xen-api mailing list [email protected] http://lists.xensource.com/mailman/listinfo/xen-api
