Added s4suspend action

diff --git a/xenvm/tasks.ml b/xenvm/tasks.ml
index edba10e9c505e19a5d8c9fa9ded43404ae07e3a3..c7049186161ce1aac238998ee5259e1eb60aa084 100644 (file)
--- 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 7375ae62cf26cbad15669a180e40bdfe489ccfab..d9fc864ed78e3ec23276bbd0d5602872cf67054a 100644 (file)
--- 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 37883bd3670bb0a6fa52fc5be4329d9d43f20415..52d8d5fe330e7e81a8c6a4bc2fc3e6a6b5771a6f 100644 (file)
--- 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;