Replace Xal.wait_release with Xs.monitor_paths, since the former ignores suspended...

This removes a constant 5s delay from the migrate downtime.

Signed-off-by: David Scott <dave.scott@eu.citrix.com>

diff --git a/ocaml/xapi/vmops.ml b/ocaml/xapi/vmops.ml
index 15ba8e00ce181654160927321d2c12a9faa3339d..6a92bcd3cdb2504c0df5ddf10cb8e36b30338f8d 100644 (file)
--- a/ocaml/xapi/vmops.ml
+++ b/ocaml/xapi/vmops.ml
@@ -882,9 +882,11 @@ let clean_shutdown_with_reason ?(at = fun _ -> ()) ~xal ~__context ~self ?(rel_t
   let result = ref None in
   while (Unix.gettimeofday () -. start < total_timeout) && (!result = None) do
     try
-      debug "MTC: calling xal.wait_release timeout=%f" rel_timeout;
-      result := Some (Xal.wait_release xal ~timeout:rel_timeout domid);
-    with Xal.Timeout -> 
+               debug "MTC: calling xal.wait_release timeout=%f" rel_timeout;
+               Xs.monitor_paths xs [ "@releaseDomain","X" ] rel_timeout
+                       (fun _ -> (Xc.domain_getinfo xc domid).Xc.shutdown);
+               result := Some (try Domain.shutdown_reason_of_int (Xc.domain_getinfo xc domid).Xc.shutdown_code with _ -> Domain.Unknown (-1));
+    with Xs.Timeout -> 
       if reason <> Domain.Suspend && TaskHelper.is_cancelling ~__context
       then raise (Api_errors.Server_error(Api_errors.task_cancelled, [ Ref.string_of (Context.get_task_id __context) ]));
       (* Update progress and repeat *)
@@ -916,16 +918,14 @@ let suspend ~live ~progress_cb ~__context ~xc ~xs ~vm =
        let suspend_SR = Helpers.choose_suspend_sr ~__context ~vm in
        let required_space = get_suspend_space __context vm in
        let handle_death = function
-               | Xal.Suspended ->
+               | Domain.Suspend ->
                        () (* good *)
-               | Xal.Crashed ->
+               | Domain.Crash ->
                        raise (Api_errors.Server_error(Api_errors.vm_crashed, [ Ref.string_of vm ]))
-               | Xal.Rebooted ->
+               | Domain.Reboot ->
                        raise (Api_errors.Server_error(Api_errors.vm_rebooted, [ Ref.string_of vm ]))
-               | Xal.Halted | Xal.Vanished ->
+               | Domain.Halt | Domain.Unknown _ ->
                        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)
        in
        let suspend_domain ~fd ~hvm () = with_xal (fun xal ->
                Domain.suspend ~xc ~xs ~hvm domid fd [] ~progress_callback:progress_cb

diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml
index 19b800a6e291b38f8d2c080cdef5672f34f8825c..d212cdeae5ece55a92f63e311ea4045c41d9f3a6 100644 (file)
--- a/ocaml/xapi/xapi_vm.ml
+++ b/ocaml/xapi/xapi_vm.ml
@@ -355,13 +355,12 @@ module Reboot = struct
                match with_xal (fun xal -> Vmops.clean_shutdown_with_reason ~xal
                                                        ~at:(fun x -> TaskHelper.set_progress ~__context (x /. 2.))
                                                        ~__context ~self:vm domid Domain.Reboot) with
-               | Xal.Vanished
-               | Xal.Rebooted -> () (* good *)
-               | Xal.Suspended ->
+               | Domain.Reboot | Domain.Unknown _ -> () (* good *)
+               | Domain.Suspend ->
                          error "VM: %s suspended when asked to reboot" (Ref.string_of vm)
-               | Xal.Crashed ->
+               | Domain.Crash ->
                          error "VM: %s crashed when asked to reboot" (Ref.string_of vm)
-               | Xal.Halted ->
+               | Domain.Halt ->
                          error "VM: %s halted when asked to reboot" (Ref.string_of vm)
       end else begin
                debug "%s phase 0/3: no shutdown request required since this is a hard_reboot" api_call_name;
@@ -493,15 +492,16 @@ module Shutdown = struct
                match with_xal (fun xal -> Vmops.clean_shutdown_with_reason ~xal
                                                        ~at:(TaskHelper.set_progress ~__context)
                                                        ~__context ~self:vm domid Domain.Halt) with
-               | Xal.Vanished
-               | Xal.Halted -> () (* good *)
-               | Xal.Suspended ->
+               | Domain.PowerOff
+               | Domain.Unknown _
+               | Domain.Halt -> () (* good *)
+               | Domain.Suspend ->
                          (* Log the failure but continue *)
                          error "VM: %s suspended when asked to shutdown" (Ref.string_of vm)
-               | Xal.Crashed ->
+               | Domain.Crash ->
                          (* Log the failure but continue *)
                        error "VM: %s crashed when asked to shutdown" (Ref.string_of vm)
-               | Xal.Rebooted ->
+               | Domain.Reboot ->
                          (* Log the failure but continue *)
                          error "VM: %s attempted to reboot when asked to shutdown" (Ref.string_of vm)
       end else begin

diff --git a/ocaml/xapi/xapi_vm_migrate.ml b/ocaml/xapi/xapi_vm_migrate.ml
index 21c5bac249992080b86b771f53aa8c0cefb9f626..3ef07448d5eef661b2efc0cd625ceadcf4be3a0e 100644 (file)
--- a/ocaml/xapi/xapi_vm_migrate.ml
+++ b/ocaml/xapi/xapi_vm_migrate.ml
@@ -136,15 +136,14 @@ let migration_suspend_cb ~xal ~xc ~xs ~__context vm_migrate_failed ~self domid r
      the migration *)
     if (ack = `ACKED) then begin
       match Vmops.clean_shutdown_with_reason ~xal ~__context ~self ~rel_timeout:0.25 domid Domain.Suspend with
-         | Xal.Suspended -> () (* good *)
-         | Xal.Crashed ->
+         | Domain.Suspend -> () (* good *)
+         | Domain.Crash ->
                  raise (Api_errors.Server_error(Api_errors.vm_crashed, [ Ref.string_of self ]))
-         | Xal.Rebooted ->
+         | Domain.Reboot ->
                  raise (Api_errors.Server_error(Api_errors.vm_rebooted, [ Ref.string_of self ]))
-         | Xal.Vanished
-         | Xal.Halted ->
+         | Domain.Unknown _
+         | Domain.Halt ->
                  raise (Api_errors.Server_error(Api_errors.vm_halted, [ Ref.string_of self ]))
-         | Xal.Shutdown x -> vm_migrate_failed (Printf.sprintf "Domain shutdown for unexpected reason: %d" x)
      end else
        vm_migrate_failed "Failed to receive suspend acknowledgement within timeout period or an abort was requested."
   ) else