From ab6d839d37675eb5eec10c468c6adb0cbe1731ab Mon Sep 17 00:00:00 2001
From: Tomasz Wroblewski <tomasz.wroblewski@citrix.com>
Date: Mon, 21 Dec 2009 11:43:26 +0000
Subject: [PATCH] Check PV driver before S3/S4. Handle case when S4 entered
 instead of S3.

---
 xenvm/vmact.ml | 98 +++++++++++++++++++++++++++++++-------------------
 1 file changed, 61 insertions(+), 37 deletions(-)

diff --git a/xenvm/vmact.ml b/xenvm/vmact.ml
index de9631f..83bf12b 100644
--- 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 *)
-- 
2.39.5