Check PV driver before S3/S4. Handle case when S4 entered instead of S3.

diff --git a/xenvm/vmact.ml b/xenvm/vmact.ml
index de9631f0b3f83a6550a7891050ce19de4d0f4bf2..83bf12b74d70456f680e90fe325904d14d6cae83 100644 (file)
--- a/xenvm/vmact.ml
+++ b/xenvm/vmact.ml
@@ -697,47 +697,71 @@ let restore xc xs state delete file =
                assert false
 
 let s3_suspend xc xs state timeout =
+       let has_pv_driver = Xc.hvm_check_pvdriver xc state.vm_domid in
        let domid = string_of_int state.vm_domid in
-       let path = "/local/domain/" ^ domid ^ "/control/shutdown" in
-       xs.Xs.write path "s3";
-       (* wait until domain gets into s3 by polling acpi state *)
-       let start_time = Unix.time () in
-       let rec wait () =
-               Unix.sleep 1;
-               let t = Unix.time () in
-               let diff = int_of_float (t -. start_time) in
-               if diff >= timeout
-               then false (* timed out, failed to put domain to sleep *)
-               else match Xc.domain_get_acpi_s_state xc state.vm_domid with
-                    | 3 -> true    (* acpi state is S3 *)
-                    | _ -> wait () (* acpi state is something else, continue wait *)
-       in
-       info "waiting for domain %s to go into s3" domid;
-       match wait () with
-       | true  -> info "succeeded to put domain %s into s3" domid; true
-       | false -> warn "failed to put domain %s into s3" domid; false
+       (* fail immediately if domain has no PV driver *)
+       if not has_pv_driver then (
+               warn "failed to put domain %s into S3: domain has no PV driver" domid;
+               false
+        ) else (
+               let path = "/local/domain/" ^ domid ^ "/control/shutdown" in
+               xs.Xs.write path "s3";
+               (* wait until domain gets into s3 by polling acpi state *)
+               let start_time = Unix.time () in
+               let rec wait () =
+                       Unix.sleep 1;
+                       let t = Unix.time () in
+                       let diff = int_of_float (t -. start_time) in
+                       if diff >= timeout
+                       then (
+                               warn "failed to put domain %s into S3 - timeout" domid;
+                               false
+                       ) else
+                               match Xc.domain_get_acpi_s_state xc state.vm_domid with
+                               | 3 -> 
+                                         (* acpi state is S3 *)
+                                         info "succeeded to put domain %s into S3" domid;
+                                         true
+                               | 4 ->
+                                         (* sometimes domain can enter S4 instead of S3, if S3
+                                            state is blocked *)
+                                         warn "domain %s entered S4 instead of S3" domid;
+                                         false
+                               | _ ->
+                                         wait () (* acpi state is something else, continue wait *)
+               in
+               info "waiting for domain %s to go into S3" domid;
+               wait()
+        )
 
 let s4_suspend xc xs state timeout =
+       let has_pv_driver = Xc.hvm_check_pvdriver xc state.vm_domid in
        let domid = string_of_int state.vm_domid in
-       let path = "/local/domain/" ^ domid ^ "/control/shutdown" in
-       xs.Xs.write path "hibernate";
-       (* wait until domain shutdowns *)
-       let start_time = Unix.time () in
-       let rec wait () =
-               Unix.sleep 1;
-               let t = Unix.time () in
-               let diff = int_of_float (t -. start_time) in
-               if diff >= timeout
-               then false (* timed out, failed to put domain to hibernate *)
-               else match state.vm_lifestate with
-                    | VmShutdown -> true
-                    | _ -> wait () (* continue waiting *)
-       in
-       info "waiting for domain %s to go into s4" domid;
-       match wait () with
-       | true  -> info "succeeded to put domain %s into s4" domid; true
-       | false -> warn "failed to put domain %s into s4" domid; false
-  
+       (* fail immediately if domain has no PV driver *)
+       if not has_pv_driver then (
+               warn "failed to put domain %s into S4: domain has no PV driver" domid;
+               false
+        ) else (
+               let path = "/local/domain/" ^ domid ^ "/control/shutdown" in
+               xs.Xs.write path "hibernate";
+               (* wait until domain shutdowns *)
+               let start_time = Unix.time () in
+               let rec wait () =
+                       Unix.sleep 1;
+                       let t = Unix.time () in
+                       let diff = int_of_float (t -. start_time) in
+                       if diff >= timeout
+                       then false (* timed out, failed to put domain to hibernate *)
+                       else match state.vm_lifestate with
+                       | VmShutdown -> true
+                       | _ -> wait () (* continue waiting *)
+               in
+               info "waiting for domain %s to go into S4" domid;
+               match wait () with
+               | true  -> info "succeeded to put domain %s into S4" domid; true
+               | false -> warn "failed to put domain %s into S4" domid; false
+        )
+
 let device_cmd xc xs state ty subcmd args =
        let cfg = state.vm_cfg in
        (* specific handler *)