move the task handler out of the monitor_rpc

diff --git a/xenvm/xenvm.ml b/xenvm/xenvm.ml
index dede25a33705b08f18d7c95d55edb02127d57d10..7926a209134942b53732fcba492c8484583c1b66 100644 (file)
--- a/xenvm/xenvm.ml
+++ b/xenvm/xenvm.ml
@@ -402,18 +402,88 @@ let monitor_vm state =
                        Thread.delay 1.
        done
 
-let monitor_rpc socket state =
-       let read_config state path =
+let reread_config state path =
+       let path =
+               match path with
+               | None -> state.vm_config_path
+               | Some path -> path
+               in
+       let cfg = Config.of_file (fun errors -> () ) path in
+       state.vm_next_cfg <- Some cfg
+
+let do_task quit state (task, args) =
+       let xs = Xs.daemon_open () in
+       let xc = Xc.interface_open () in
+
+       let task_desc = List.assoc task Tasks.actions_table in
+       (*maybe assert_vmstate task_vmstate_required;*)
+       match task with
+       | Tasks.Quit ->
+               quit := true; Xenvmlib.Ok
+       | Tasks.Help ->
+               do_help ();
+       | Tasks.Destroy -> Vmact.stop_vm xc xs state; Xenvmlib.Ok
+       | Tasks.Halt ->
+               let force = Tasks.args_get_bool args "forced" in
+               Misc.with_xal (fun xal -> Vmact.shutdown_vm xc xs xal state force Domain.Halt);
+               Vmact.stop_vm xc xs state;
+               Xenvmlib.Ok
+       | Tasks.Reboot ->
+               let force = Tasks.args_get_bool args "forced" in
+               Misc.with_xal (fun xal -> Vmact.shutdown_vm xc xs xal state force Domain.Reboot);
+               Vmact.stop_vm xc xs state;
+               Vmact.start_vm xc xs state;
+               Xenvmlib.Ok
+       | Tasks.Start -> Vmact.start_vm xc xs state; Xenvmlib.Ok
+       | Tasks.Pause -> Vmact.pause_vm xc state; Xenvmlib.Ok
+       | Tasks.Unpause -> Vmact.unpause_vm xc state; Xenvmlib.Ok
+       | Tasks.Suspend ->
+               let file = Tasks.args_get_string args "file" in
+               let live = Tasks.args_get_bool args "live" in
+               state.vm_on_suspend_action <- ActionSuspend;
+               Vmact.suspend xc xs state (if live then [ Domain.Live ] else []) (with_datadir state.vm_cfg file);
+               Vmact.stop_vm xc xs state;
+               Xenvmlib.Ok
+       | Tasks.Restore ->
+               let file = Tasks.args_get_string args "file" in
+               let delete = Tasks.args_get_bool args "delete" in
+               Vmact.change_vmstate state VmRestoring;
+               Vmact.restore xc xs state delete (with_datadir state.vm_cfg file);
+               Xenvmlib.Ok
+       | Tasks.Checkpoint ->
+               let file = Tasks.args_get_string args "file" in
+               state.vm_on_suspend_action <- ActionResume;
+               Vmact.suspend xc xs state [] (with_datadir state.vm_cfg file);
+               Xenvmlib.Ok
+       | Tasks.GetDomid -> Xenvmlib.Msg (string_of_int state.vm_domid)
+       | Tasks.GetStatus -> Xenvmlib.Msg (string_of_vmlifestate state.vm_lifestate)
+       | Tasks.GetVNC -> Xenvmlib.Msg (string_of_int state.vm_vnc_port)
+       | Tasks.Get ->
+               let field = Tasks.args_get_string args "field" in
+               Vmact.get state field
+       | Tasks.Set ->
+               let field = Tasks.args_get_string args "field" in
+               let value = Tasks.args_get_string args "value" in
+               Vmact.set state field value
+       | Tasks.Trigger ->
+               let params = Tasks.args_get_liststring args "params" in
+               Vmact.do_trigger xc state params
+       | Tasks.Device ->
+               let ty = Tasks.args_get_string args "type" in
+               let cmd = Tasks.args_get_string args "cmd" in
+               let extra = Tasks.args_get_liststring args "extra" in
+               Vmact.device_cmd xc xs state ty cmd extra
+       | Tasks.ReadConfig ->
                let path =
-                       match path with
-                       | None -> state.vm_config_path
-                       | Some path -> path
+                       try Some (Tasks.args_get_string args "path")
+                       with _ -> None
                        in
-               let cfg = Config.of_file (fun errors -> () ) path in
-               state.vm_next_cfg <- Some cfg
-               in
+               reread_config state path;
+               Xenvmlib.Ok
+
+let monitor_rpc socket state =
        let read_config_noexn state path =
-               try read_config state path
+               try reread_config state path
                with exn ->
                        info "receive exception reading config file ignoring: %s"
                             (string_of_exn exn)
@@ -422,80 +492,9 @@ let monitor_rpc socket state =
                if expected <> state.vm_lifestate then
                        raise (Vmact.Vm_bad_state (expected, state.vm_lifestate));
                in
-       let with_datadir file = with_datadir state.vm_cfg file in
        let quit = ref false in
        let connections = ref [] in
 
-       let xs = Xs.daemon_open () in
-       let xc = Xc.interface_open () in
-
-       let do_task (task, args) =
-               let task_desc = List.assoc task Tasks.actions_table in
-               (*maybe assert_vmstate task_vmstate_required;*)
-               match task with
-               | Tasks.Quit ->
-                       quit := true; Xenvmlib.Ok
-               | Tasks.Help ->
-                       do_help ();
-               | Tasks.Destroy -> Vmact.stop_vm xc xs state; Xenvmlib.Ok
-               | Tasks.Halt ->
-                       let force = Tasks.args_get_bool args "forced" in
-                       Misc.with_xal (fun xal -> Vmact.shutdown_vm xc xs xal state force Domain.Halt);
-                       Vmact.stop_vm xc xs state;
-                       Xenvmlib.Ok
-               | Tasks.Reboot ->
-                       let force = Tasks.args_get_bool args "forced" in
-                       Misc.with_xal (fun xal -> Vmact.shutdown_vm xc xs xal state force Domain.Reboot);
-                       Vmact.stop_vm xc xs state;
-                       Vmact.start_vm xc xs state;
-                       Xenvmlib.Ok
-               | Tasks.Start -> Vmact.start_vm xc xs state; Xenvmlib.Ok
-               | Tasks.Pause -> Vmact.pause_vm xc state; Xenvmlib.Ok
-               | Tasks.Unpause -> Vmact.unpause_vm xc state; Xenvmlib.Ok
-               | Tasks.Suspend ->
-                       let file = Tasks.args_get_string args "file" in
-                       let live = Tasks.args_get_bool args "live" in
-                       state.vm_on_suspend_action <- ActionSuspend;
-                       Vmact.suspend xc xs state (if live then [ Domain.Live ] else []) (with_datadir file);
-                       Vmact.stop_vm xc xs state;
-                       Xenvmlib.Ok
-               | Tasks.Restore ->
-                       let file = Tasks.args_get_string args "file" in
-                       let delete = Tasks.args_get_bool args "delete" in
-                       Vmact.change_vmstate state VmRestoring;
-                       Vmact.restore xc xs state delete (with_datadir file);
-                       Xenvmlib.Ok
-               | Tasks.Checkpoint ->
-                       let file = Tasks.args_get_string args "file" in
-                       state.vm_on_suspend_action <- ActionResume;
-                       Vmact.suspend xc xs state [] (with_datadir file);
-                       Xenvmlib.Ok
-               | Tasks.GetDomid -> Xenvmlib.Msg (string_of_int state.vm_domid)
-               | Tasks.GetStatus -> Xenvmlib.Msg (string_of_vmlifestate state.vm_lifestate)
-               | Tasks.GetVNC -> Xenvmlib.Msg (string_of_int state.vm_vnc_port)
-               | Tasks.Get ->
-                       let field = Tasks.args_get_string args "field" in
-                       Vmact.get state field
-               | Tasks.Set ->
-                       let field = Tasks.args_get_string args "field" in
-                       let value = Tasks.args_get_string args "value" in
-                       Vmact.set state field value
-               | Tasks.Trigger ->
-                       let params = Tasks.args_get_liststring args "params" in
-                       Vmact.do_trigger xc state params
-               | Tasks.Device ->
-                       let ty = Tasks.args_get_string args "type" in
-                       let cmd = Tasks.args_get_string args "cmd" in
-                       let extra = Tasks.args_get_liststring args "extra" in
-                       Vmact.device_cmd xc xs state ty cmd extra
-               | Tasks.ReadConfig ->
-                       let path =
-                               try Some (Tasks.args_get_string args "path")
-                               with _ -> None
-                               in
-                       read_config state path;
-                       Xenvmlib.Ok
-               in
        Sys.set_signal Sys.sigint (Sys.Signal_handle (fun i -> quit := true));
        Sys.set_signal Sys.sighup (Sys.Signal_handle (fun i -> read_config_noexn state None));
 
@@ -516,7 +515,7 @@ let monitor_rpc socket state =
                        let fd = con_get_fd con in
                        if List.mem fd r then (
                                thread_create (fun () ->
-                                       con_legacy_process con do_task;
+                                       con_legacy_process con (do_task quit state);
                                        con_close con;
                                ) ();
                                connections := List.filter (fun c -> c <> con) !connections;
@@ -524,6 +523,8 @@ let monitor_rpc socket state =
                ) !connections;
        done;
        if state.vm_domid <> (-1) then (
+               let xs = Xs.daemon_open () in
+               let xc = Xc.interface_open () in
                Vmact.stop_vm xc xs state;
                Vmact.change_vmstate state VmShutdown
        )