From: Tomasz Wroblewski <tomasz.wroblewski@citrix.com>
Date: Wed, 18 Nov 2009 18:17:49 +0000 (+0000)
Subject: Added s4suspend action
X-Git-Url: http://xenbits.xensource.com/gitweb?a=commitdiff_plain;h=1b596ddb546a53e827b40960848ef5ff45b30417;p=xenclient%2Ftoolstack.git

Added s4suspend action
---

diff --git a/xenvm/tasks.ml b/xenvm/tasks.ml
index edba10e..c704918 100644
--- a/xenvm/tasks.ml
+++ b/xenvm/tasks.ml
@@ -24,7 +24,8 @@ type action =
 	| Unpause
 	| Suspend
 	| Restore
-	| S3Suspend    
+	| S3Suspend
+	| S4Suspend
 	| Checkpoint
 	| GetDomid
 	| GetStatus
@@ -92,6 +93,7 @@ let actions_table = [
 	                                      ("file", R, ArgString); ] );
 	(Restore,    mk_desc_args "restore" [ "file", R, ArgString ] );
 	(S3Suspend,  mk_desc_args "s3suspend" [ "timeout", O, ArgInt ]);
+	(S4Suspend,  mk_desc_args "s4suspend" [ "timeout", O, ArgInt ]);
 	(GetDomid,   mk_desc_nb "get-domid");
 	(GetStatus,  mk_desc_nb "get-status");
         (GetAcpiState, mk_desc_nb "get-acpi-state");
diff --git a/xenvm/vmact.ml b/xenvm/vmact.ml
index 7375ae6..d9fc864 100644
--- a/xenvm/vmact.ml
+++ b/xenvm/vmact.ml
@@ -636,6 +636,27 @@ let s3_suspend xc xs state timeout =
 	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
+
+let s4_suspend xc xs state timeout =
+	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
   
 let device_cmd xc xs state ty subcmd args =
 	let cfg = state.vm_cfg in
diff --git a/xenvm/xenvm.ml b/xenvm/xenvm.ml
index 37883bd..52d8d5f 100644
--- a/xenvm/xenvm.ml
+++ b/xenvm/xenvm.ml
@@ -449,6 +449,12 @@ let do_task state (task, args) =
 		(match with_xcs (fun xc xs -> Vmact.s3_suspend xc xs state timeout) with
 		| true  -> Xenvmlib.Ok
 		| false -> Xenvmlib.Error "failed to put domain into s3")
+	| Tasks.S4Suspend ->
+		let timeout = optional_arg (Int64.of_int 30) Tasks.args_get_int args "timeout" in
+		let timeout = Int64.to_int timeout in
+		(match with_xcs (fun xc xs -> Vmact.s4_suspend xc xs state timeout) with
+		| true  -> Xenvmlib.Ok
+		| false -> Xenvmlib.Error "failed to put domain into s4")
 	| Tasks.Checkpoint ->
 		let file = Tasks.args_get_string args "file" in
 		state.vm_on_suspend_action <- ActionResume;