From: Tomasz Wroblewski <tomasz.wroblewski@citrix.com>
Date: Thu, 5 Nov 2009 11:12:56 +0000 (+0000)
Subject: Add s3suspend command
X-Git-Url: http://xenbits.xensource.com/gitweb?a=commitdiff_plain;h=136e15f1cf8ad6e05faa502a46902b22f947ddbd;p=xenclient%2Ftoolstack.git

Add s3suspend command
---

diff --git a/xenvm/tasks.ml b/xenvm/tasks.ml
index 1373404..5a7fab5 100644
--- a/xenvm/tasks.ml
+++ b/xenvm/tasks.ml
@@ -24,6 +24,7 @@ type action =
 	| Unpause
 	| Suspend
 	| Restore
+	| S3Suspend    
 	| Checkpoint
 	| GetDomid
 	| GetStatus
@@ -89,6 +90,7 @@ let actions_table = [
 	(Suspend,    mk_desc_args "suspend" [ ("live", D (ValBool false), ArgBool);
 	                                      ("file", R, ArgString); ] );
 	(Restore,    mk_desc_args "restore" [ "file", R, ArgString ] );
+	(S3Suspend,  mk_desc_args "s3suspend" [ "timeout", O, ArgInt ]);
 	(GetDomid,   mk_desc_nb "get-domid");
 	(GetStatus,  mk_desc_nb "get-status");
 	(GetVNC,     mk_desc_nb "get-vnc");
diff --git a/xenvm/vmact.ml b/xenvm/vmact.ml
index 5c9acc5..caa66f1 100644
--- a/xenvm/vmact.ml
+++ b/xenvm/vmact.ml
@@ -575,6 +575,27 @@ let restore xc xs state delete file =
 	| _ ->
 		assert false
 
+let s3_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 "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
+  
 let device_cmd xc xs state ty subcmd args =
 	let cfg = state.vm_cfg in
 	(* specific handler *)
diff --git a/xenvm/xenvm.ml b/xenvm/xenvm.ml
index 58c69c4..715f1a7 100644
--- a/xenvm/xenvm.ml
+++ b/xenvm/xenvm.ml
@@ -443,6 +443,12 @@ let do_task state (task, args) =
 		Vmact.change_vmstate state VmRestoring;
 		with_xcs (fun xc xs -> Vmact.restore xc xs state delete (with_datadir state.vm_cfg file));
 		Xenvmlib.Ok
+	| Tasks.S3Suspend ->
+		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.s3_suspend xc xs state timeout) with
+		| true  -> Xenvmlib.Ok
+		| false -> Xenvmlib.Error "failed to put domain into s3")
 	| Tasks.Checkpoint ->
 		let file = Tasks.args_get_string args "file" in
 		state.vm_on_suspend_action <- ActionResume;
diff --git a/xenvm/xenvm_cmd.ml b/xenvm/xenvm_cmd.ml
index e097e10..6b4a078 100644
--- a/xenvm/xenvm_cmd.ml
+++ b/xenvm/xenvm_cmd.ml
@@ -26,10 +26,12 @@ let valid_kvpairs args =
 
 let _ =
 	let using_socket = ref false in
-	let usage_msg = sprintf "usage: %s [--use-socket] <uuid> <cmd> [cmd args]\n" Sys.argv.(0) in
+	let timeout = ref 60 in
+	let usage_msg = sprintf "usage: %s [--use-socket] [--reply-timeout <secs>] <uuid> <cmd> [cmd args]\n" Sys.argv.(0) in
 	let args = ref [] in
 	Arg.parse [
 		("--use-socket", Arg.Set using_socket, "use socket instead of dbus");
+		("--reply-timeout", Arg.Int (fun t -> timeout := t), "set the timeout (in seconds), defaults to 60");
 	] (fun s -> args := s :: !args) usage_msg;
 	let args = List.rev !args in
 
@@ -42,7 +44,7 @@ let _ =
 		in
 
 	try
-		match Xenvmlib.request ~using_socket ~timeout:60.0 uuid query with
+		match Xenvmlib.request ~using_socket ~timeout:(float_of_int !timeout) uuid query with
 		| Xenvmlib.Ok          -> ()
 		| Xenvmlib.Timeout     -> eprintf "timeout\n"; exit 1
 		| Xenvmlib.Error error -> eprintf "error: %s\n" error; exit 1