From 80f1be40b2449a2179a2fcb3471895ad4ee15889 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Sun, 3 May 2009 18:23:26 +0100 Subject: [PATCH] move the task handler out of the monitor_rpc --- xenvm/xenvm.ml | 163 +++++++++++++++++++++++++------------------------ 1 file changed, 82 insertions(+), 81 deletions(-) diff --git a/xenvm/xenvm.ml b/xenvm/xenvm.ml index dede25a..7926a20 100644 --- 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 ) -- 2.39.5