2018-09-09 18:52:04 +00:00
|
|
|
(* (c) 2017, 2018 Hannes Mehnert, all rights reserved *)
|
2017-05-26 14:30:34 +00:00
|
|
|
|
|
|
|
open Astring
|
|
|
|
|
|
|
|
open Vmm_core
|
|
|
|
|
|
|
|
open Rresult
|
|
|
|
open R.Infix
|
|
|
|
|
2018-09-09 18:52:04 +00:00
|
|
|
type 'a t = {
|
2018-10-23 22:03:36 +00:00
|
|
|
wire_version : Vmm_commands.version ;
|
2018-09-09 18:52:04 +00:00
|
|
|
console_counter : int64 ;
|
|
|
|
stats_counter : int64 ;
|
|
|
|
log_counter : int64 ;
|
2017-05-26 14:30:34 +00:00
|
|
|
resources : Vmm_resources.t ;
|
2019-01-20 20:41:49 +00:00
|
|
|
waiters : 'a String.Map.t ;
|
2017-05-26 14:30:34 +00:00
|
|
|
}
|
|
|
|
|
2019-01-20 21:17:59 +00:00
|
|
|
let in_shutdown = ref false
|
|
|
|
|
2019-01-20 21:01:52 +00:00
|
|
|
let killall t =
|
|
|
|
match List.map snd (Vmm_trie.all t.resources.Vmm_resources.unikernels) with
|
|
|
|
| [] -> false
|
2019-01-20 21:17:59 +00:00
|
|
|
| vms -> in_shutdown := true ; List.iter Vmm_unix.destroy vms ; true
|
2019-01-18 00:14:11 +00:00
|
|
|
|
2019-10-10 23:10:33 +00:00
|
|
|
let remove_resources t name =
|
|
|
|
let resources = match Vmm_resources.remove_vm t.resources name with
|
|
|
|
| Error (`Msg e) ->
|
|
|
|
Logs.warn (fun m -> m "%s while removing vm %a from resources" e Name.pp name) ;
|
|
|
|
t.resources
|
|
|
|
| Ok resources -> resources
|
|
|
|
in
|
|
|
|
{ t with resources }
|
|
|
|
|
|
|
|
let dump_unikernels t =
|
|
|
|
let unikernels = Vmm_trie.all t.resources.Vmm_resources.unikernels in
|
|
|
|
let trie = List.fold_left (fun t (name, unik) ->
|
|
|
|
fst @@ Vmm_trie.insert name unik.Unikernel.config t)
|
|
|
|
Vmm_trie.empty unikernels
|
|
|
|
in
|
|
|
|
let data = Vmm_asn.unikernels_to_cstruct trie in
|
|
|
|
match Vmm_unix.dump data with
|
|
|
|
| Error (`Msg msg) -> Logs.err (fun m -> m "failed to dump unikernels: %s" msg)
|
|
|
|
| Ok () -> Logs.info (fun m -> m "dumped current state")
|
|
|
|
|
2019-01-20 20:41:49 +00:00
|
|
|
let waiter t id =
|
2019-10-10 23:10:33 +00:00
|
|
|
let t = remove_resources t id in
|
2019-01-20 20:41:49 +00:00
|
|
|
let name = Name.to_string id in
|
2019-10-10 23:10:33 +00:00
|
|
|
if not !in_shutdown then dump_unikernels t ;
|
2019-01-20 20:41:49 +00:00
|
|
|
match String.Map.find name t.waiters with
|
|
|
|
| None -> t, None
|
|
|
|
| Some waiter ->
|
|
|
|
let waiters = String.Map.remove name t.waiters in
|
|
|
|
{ t with waiters }, Some waiter
|
|
|
|
|
|
|
|
let register t id create =
|
2019-10-10 23:10:33 +00:00
|
|
|
let name = Name.to_string id in
|
|
|
|
let task, waiter = create () in
|
|
|
|
{ t with waiters = String.Map.add name waiter t.waiters }, task
|
|
|
|
|
|
|
|
let register_restart t id create =
|
2019-01-20 20:41:49 +00:00
|
|
|
let name = Name.to_string id in
|
|
|
|
match String.Map.find name t.waiters with
|
2019-10-10 23:10:33 +00:00
|
|
|
| Some _ -> Logs.err (fun m -> m "restart attempted to overwrite waiter"); None
|
|
|
|
| _ -> Some (register t id create)
|
2019-01-20 20:41:49 +00:00
|
|
|
|
2018-11-10 00:02:07 +00:00
|
|
|
let init wire_version =
|
|
|
|
let t = {
|
|
|
|
wire_version ;
|
|
|
|
console_counter = 1L ;
|
|
|
|
stats_counter = 1L ;
|
|
|
|
log_counter = 1L ;
|
|
|
|
resources = Vmm_resources.empty ;
|
2019-01-20 20:41:49 +00:00
|
|
|
waiters = String.Map.empty ;
|
2018-11-10 00:02:07 +00:00
|
|
|
} in
|
|
|
|
match Vmm_unix.find_block_devices () with
|
|
|
|
| Error (`Msg msg) ->
|
|
|
|
Logs.warn (fun m -> m "couldn't find block devices %s" msg) ;
|
|
|
|
t
|
|
|
|
| Ok devs ->
|
|
|
|
let resources =
|
|
|
|
List.fold_left (fun r (id, size) ->
|
|
|
|
match Vmm_resources.insert_block r id size with
|
|
|
|
| Error (`Msg msg) ->
|
2018-11-13 00:02:05 +00:00
|
|
|
Logs.err (fun m -> m "couldn't insert block device %a (%dMB): %s" Name.pp id size msg) ;
|
2018-11-10 00:02:07 +00:00
|
|
|
r
|
|
|
|
| Ok r -> r)
|
|
|
|
t.resources devs
|
|
|
|
in
|
|
|
|
{ t with resources }
|
2017-05-26 14:30:34 +00:00
|
|
|
|
2019-01-20 21:04:41 +00:00
|
|
|
type 'a create =
|
2019-01-27 15:07:53 +00:00
|
|
|
Vmm_commands.wire *
|
|
|
|
('a t -> ('a t * Vmm_commands.wire * Vmm_commands.wire * Vmm_commands.wire * Name.t * Unikernel.t, [ `Msg of string ]) result) *
|
|
|
|
(unit -> Vmm_commands.wire)
|
2019-01-20 21:04:41 +00:00
|
|
|
|
2018-11-11 00:21:12 +00:00
|
|
|
let log t name event =
|
2018-10-23 22:03:36 +00:00
|
|
|
let data = (Ptime_clock.now (), event) in
|
2018-11-11 00:21:12 +00:00
|
|
|
let header = Vmm_commands.{ version = t.wire_version ; sequence = t.log_counter ; name } in
|
2018-10-22 21:20:00 +00:00
|
|
|
let log_counter = Int64.succ t.log_counter in
|
2018-10-23 22:03:36 +00:00
|
|
|
Logs.debug (fun m -> m "log %a" Log.pp data) ;
|
2019-01-27 15:07:53 +00:00
|
|
|
({ t with log_counter }, (header, `Data (`Log_data data)))
|
2017-05-26 14:30:34 +00:00
|
|
|
|
2019-01-20 21:17:59 +00:00
|
|
|
let restore_unikernels () =
|
|
|
|
match Vmm_unix.restore () with
|
|
|
|
| Error `NoFile ->
|
|
|
|
Logs.warn (fun m -> m "no state dump found, starting with no unikernels") ;
|
|
|
|
Ok Vmm_trie.empty
|
|
|
|
| Error (`Msg msg) -> Error (`Msg ("while reading state: " ^ msg))
|
|
|
|
| Ok data ->
|
|
|
|
match Vmm_asn.unikernels_of_cstruct data with
|
|
|
|
| Error (`Msg msg) -> Error (`Msg ("couldn't parse state: " ^ msg))
|
|
|
|
| Ok unikernels ->
|
2019-10-10 20:26:36 +00:00
|
|
|
Logs.info (fun m -> m "restored %d unikernels" (List.length (Vmm_trie.all unikernels))) ;
|
2019-01-20 21:17:59 +00:00
|
|
|
Ok unikernels
|
|
|
|
|
2019-01-20 20:48:44 +00:00
|
|
|
let setup_stats t name vm =
|
|
|
|
let stat_out =
|
2019-01-20 22:02:01 +00:00
|
|
|
let name = match Vmm_unix.vm_device vm with
|
|
|
|
| Error _ -> ""
|
|
|
|
| Ok name -> name
|
2019-09-28 17:09:45 +00:00
|
|
|
and ifs = Unikernel.(List.combine vm.config.bridges vm.taps)
|
2019-01-20 20:48:44 +00:00
|
|
|
in
|
2019-01-20 22:02:01 +00:00
|
|
|
`Stats_add (name, vm.Unikernel.pid, ifs)
|
2019-01-20 20:48:44 +00:00
|
|
|
in
|
|
|
|
let header = Vmm_commands.{ version = t.wire_version ; sequence = t.stats_counter ; name } in
|
|
|
|
let t = { t with stats_counter = Int64.succ t.stats_counter } in
|
2019-01-27 15:07:53 +00:00
|
|
|
t, (header, `Command (`Stats_cmd stat_out))
|
2019-01-20 20:48:44 +00:00
|
|
|
|
|
|
|
let remove_stats t name =
|
|
|
|
let header = Vmm_commands.{ version = t.wire_version ; sequence = t.stats_counter ; name } in
|
|
|
|
let t = { t with stats_counter = Int64.succ t.stats_counter } in
|
2019-01-27 15:07:53 +00:00
|
|
|
(t, (header, `Command (`Stats_cmd `Stats_remove)))
|
2019-01-20 20:48:44 +00:00
|
|
|
|
2019-01-27 15:07:53 +00:00
|
|
|
let handle_create t hdr name vm_config =
|
2018-10-22 22:54:05 +00:00
|
|
|
(match Vmm_resources.find_vm t.resources name with
|
2018-10-12 23:05:21 +00:00
|
|
|
| Some _ -> Error (`Msg "VM with same name is already running")
|
|
|
|
| None -> Ok ()) >>= fun () ->
|
|
|
|
Logs.debug (fun m -> m "now checking resource policies") ;
|
2018-11-12 22:56:29 +00:00
|
|
|
Vmm_resources.check_vm t.resources name vm_config >>= fun () ->
|
2017-05-26 14:30:34 +00:00
|
|
|
(* prepare VM: save VM image to disk, create fifo, ... *)
|
2018-10-22 22:54:05 +00:00
|
|
|
Vmm_unix.prepare name vm_config >>= fun taps ->
|
revise force-restart: now with wait for kill and resource cleanup before start
allows to cleanup various hacks, such as checking for pid in vmm_resources
or removing temporarily the allocated resources from the resource map in vmm_engine
semantics is now slightly different, but for sure enhanced.
- each VM has a Lwt.wait () task attached in Vmm_engine.t (tasks : 'c String.Map.t)
- normal create shouldn't be much different, apart from memoizing the sleeper
- after waitpid is done in vmmd, and vmm_engine.shutdown succeeded, Lwt.wakeup is called for the sleeper
- force create now:
- checks static policies
- looks for existing VM (and task), if present: kill and wait for task in vmmd
- continue with presence checking of vm name, dynamic policies, allocate resources (tap, img, fifo)
this means the whole randomness in filenames can be removed, and the
communication between vmm_console and vmm_client is working again (attach/detach
could not work since vmm_console knew only about "albatross.AAA.BBB.RANDOM",
whereas vmm_client insisted on "AAA.BBB"
resource overcommitment (and races in e.g. block device closing + opening) are
gone now, only if the old vm is cleanup up, resources for the new one are
allocated and it is executed
2018-04-04 23:02:45 +00:00
|
|
|
Logs.debug (fun m -> m "prepared vm with taps %a" Fmt.(list ~sep:(unit ",@ ") string) taps) ;
|
2018-10-22 23:36:44 +00:00
|
|
|
let cons_out =
|
2018-11-11 00:21:12 +00:00
|
|
|
let header = Vmm_commands.{ version = t.wire_version ; sequence = t.console_counter ; name } in
|
2018-10-22 23:36:44 +00:00
|
|
|
(header, `Command (`Console_cmd `Console_add))
|
|
|
|
in
|
2019-01-27 15:07:53 +00:00
|
|
|
let success t =
|
2019-01-27 15:46:49 +00:00
|
|
|
(* actually execute the vm:
|
|
|
|
- check for safety that executing it would not exceed any resources
|
|
|
|
- execute it
|
|
|
|
- update resources
|
|
|
|
--> if either the first or second fails, then the fail continuation
|
|
|
|
below needs to be called *)
|
|
|
|
Vmm_resources.check_vm t.resources name vm_config >>= fun () ->
|
2019-09-28 17:09:45 +00:00
|
|
|
let ifs = List.combine vm_config.bridges taps
|
|
|
|
and block_devices =
|
|
|
|
List.map (fun d -> d, Name.block_name name d)
|
|
|
|
vm_config.Unikernel.block_devices
|
|
|
|
in
|
|
|
|
Vmm_unix.exec name vm_config ifs block_devices >>| fun vm ->
|
2019-01-27 15:07:53 +00:00
|
|
|
Logs.debug (fun m -> m "exec()ed vm") ;
|
2019-01-27 15:46:49 +00:00
|
|
|
let resources = Vmm_resources.insert_vm t.resources name vm in
|
2019-01-27 15:07:53 +00:00
|
|
|
let t = { t with resources } in
|
|
|
|
dump_unikernels t ;
|
2019-09-28 17:09:45 +00:00
|
|
|
let t, log_out =
|
|
|
|
let start =
|
|
|
|
`Unikernel_start (name, vm.Unikernel.pid, ifs, block_devices)
|
|
|
|
in
|
|
|
|
log t name start
|
|
|
|
in
|
2019-01-27 15:07:53 +00:00
|
|
|
let t, stat_out = setup_stats t name vm in
|
2019-01-27 15:46:49 +00:00
|
|
|
(t, stat_out, log_out, (hdr, `Success (`String "created VM")), name, vm)
|
2019-01-27 15:07:53 +00:00
|
|
|
and fail () =
|
2019-10-11 21:04:51 +00:00
|
|
|
match Vmm_unix.free_system_resources name taps with
|
2019-01-27 15:07:53 +00:00
|
|
|
| Ok () -> (hdr, `Failure "could not create VM: console failed")
|
|
|
|
| Error (`Msg msg) ->
|
|
|
|
let m = "could not create VM: console failed, and also " ^ msg ^ " while cleaning resources" in
|
|
|
|
(hdr, `Failure m)
|
|
|
|
in
|
2018-10-25 23:11:41 +00:00
|
|
|
Ok ({ t with console_counter = Int64.succ t.console_counter },
|
2019-10-11 21:04:59 +00:00
|
|
|
(cons_out, success, fail))
|
2017-05-26 14:30:34 +00:00
|
|
|
|
2018-10-22 22:54:05 +00:00
|
|
|
let handle_shutdown t name vm r =
|
2019-10-11 21:04:51 +00:00
|
|
|
(match Vmm_unix.free_system_resources name vm.Unikernel.taps with
|
2017-05-26 14:30:34 +00:00
|
|
|
| Ok () -> ()
|
2019-10-11 21:04:59 +00:00
|
|
|
| Error (`Msg e) ->
|
|
|
|
Logs.err (fun m -> m "%s while shutdown vm %a" e Unikernel.pp vm));
|
2019-01-27 15:07:53 +00:00
|
|
|
let t, log_out = log t name (`Unikernel_stop (name, vm.Unikernel.pid, r)) in
|
2019-01-20 20:48:44 +00:00
|
|
|
let t, stat_out = remove_stats t name in
|
2019-01-27 15:07:53 +00:00
|
|
|
(t, stat_out, log_out)
|
2018-09-09 18:52:04 +00:00
|
|
|
|
2018-11-10 00:02:07 +00:00
|
|
|
let handle_policy_cmd t reply id = function
|
|
|
|
| `Policy_remove ->
|
2018-11-11 00:21:12 +00:00
|
|
|
Logs.debug (fun m -> m "remove policy %a" Name.pp id) ;
|
2018-11-10 00:02:07 +00:00
|
|
|
Vmm_resources.remove_policy t.resources id >>= fun resources ->
|
2019-01-27 15:07:53 +00:00
|
|
|
Ok ({ t with resources }, `End (reply (`String "removed policy")))
|
2018-11-10 00:02:07 +00:00
|
|
|
| `Policy_add policy ->
|
2018-11-11 00:21:12 +00:00
|
|
|
Logs.debug (fun m -> m "insert policy %a" Name.pp id) ;
|
2018-11-10 00:02:07 +00:00
|
|
|
let same_policy = match Vmm_resources.find_policy t.resources id with
|
|
|
|
| None -> false
|
2018-11-11 02:09:37 +00:00
|
|
|
| Some p' -> Policy.equal policy p'
|
2018-11-10 00:02:07 +00:00
|
|
|
in
|
|
|
|
if same_policy then
|
2019-01-27 15:07:53 +00:00
|
|
|
Ok (t, `Loop (reply (`String "no modification of policy")))
|
2018-11-10 00:02:07 +00:00
|
|
|
else
|
|
|
|
Vmm_resources.insert_policy t.resources id policy >>= fun resources ->
|
2019-01-27 15:07:53 +00:00
|
|
|
Ok ({ t with resources }, `Loop (reply (`String "added policy")))
|
2018-11-10 00:02:07 +00:00
|
|
|
| `Policy_info ->
|
2018-11-11 00:21:12 +00:00
|
|
|
Logs.debug (fun m -> m "policy %a" Name.pp id) ;
|
2018-11-10 00:02:07 +00:00
|
|
|
let policies =
|
2018-11-12 22:56:29 +00:00
|
|
|
Vmm_trie.fold id t.resources.Vmm_resources.policies
|
2018-11-10 00:02:07 +00:00
|
|
|
(fun prefix policy policies-> (prefix, policy) :: policies)
|
|
|
|
[]
|
|
|
|
in
|
|
|
|
match policies with
|
|
|
|
| [] ->
|
2018-11-11 00:21:12 +00:00
|
|
|
Logs.debug (fun m -> m "policies: couldn't find %a" Name.pp id) ;
|
2018-11-10 00:02:07 +00:00
|
|
|
Error (`Msg "policy: not found")
|
|
|
|
| _ ->
|
2019-01-27 15:07:53 +00:00
|
|
|
Ok (t, `End (reply (`Policies policies)))
|
2018-11-10 00:02:07 +00:00
|
|
|
|
2019-10-10 23:10:33 +00:00
|
|
|
let handle_unikernel_cmd t reply header id = function
|
2018-11-13 00:02:05 +00:00
|
|
|
| `Unikernel_info ->
|
2018-11-11 00:21:12 +00:00
|
|
|
Logs.debug (fun m -> m "info %a" Name.pp id) ;
|
2018-11-10 00:02:07 +00:00
|
|
|
let vms =
|
2018-11-12 22:56:29 +00:00
|
|
|
Vmm_trie.fold id t.resources.Vmm_resources.unikernels
|
2018-11-13 00:02:05 +00:00
|
|
|
(fun id vm vms -> (id, vm.Unikernel.config) :: vms)
|
2018-11-10 00:02:07 +00:00
|
|
|
[]
|
|
|
|
in
|
|
|
|
begin match vms with
|
|
|
|
| [] ->
|
2018-11-11 00:21:12 +00:00
|
|
|
Logs.debug (fun m -> m "info: couldn't find %a" Name.pp id) ;
|
2018-11-13 00:02:05 +00:00
|
|
|
Error (`Msg "info: no unikernel found")
|
2018-11-10 00:02:07 +00:00
|
|
|
| _ ->
|
2019-01-27 15:07:53 +00:00
|
|
|
Ok (t, `End (reply (`Unikernels vms)))
|
2018-11-10 00:02:07 +00:00
|
|
|
end
|
2019-10-10 23:10:33 +00:00
|
|
|
| `Unikernel_create vm_config -> Ok (t, `Create (header, id, vm_config))
|
2018-11-13 00:02:05 +00:00
|
|
|
| `Unikernel_force_create vm_config ->
|
2018-11-10 00:02:07 +00:00
|
|
|
begin
|
|
|
|
let resources =
|
|
|
|
match Vmm_resources.remove_vm t.resources id with
|
2019-10-10 23:10:33 +00:00
|
|
|
| Error _ -> t.resources | Ok r -> r
|
2018-11-10 00:02:07 +00:00
|
|
|
in
|
2018-11-12 22:56:29 +00:00
|
|
|
Vmm_resources.check_vm resources id vm_config >>= fun () ->
|
|
|
|
match Vmm_resources.find_vm t.resources id with
|
2019-10-10 23:10:33 +00:00
|
|
|
| None -> Ok (t, `Create (header, id, vm_config))
|
2018-11-12 22:56:29 +00:00
|
|
|
| Some vm ->
|
2019-10-10 23:10:33 +00:00
|
|
|
(match Vmm_unix.destroy vm with
|
|
|
|
| exception Unix.Unix_error _ -> ()
|
|
|
|
| () -> ());
|
|
|
|
Ok (t, `Wait_and_create (id, (header, id, vm_config)))
|
2018-11-10 00:02:07 +00:00
|
|
|
end
|
2018-11-13 00:02:05 +00:00
|
|
|
| `Unikernel_destroy ->
|
2018-11-10 00:02:07 +00:00
|
|
|
match Vmm_resources.find_vm t.resources id with
|
2019-10-10 23:10:33 +00:00
|
|
|
| None -> Error (`Msg "destroy: not found")
|
2018-11-10 00:02:07 +00:00
|
|
|
| Some vm ->
|
2019-10-10 23:10:33 +00:00
|
|
|
let answer =
|
|
|
|
try
|
|
|
|
Vmm_unix.destroy vm ; "destroyed unikernel"
|
|
|
|
with
|
|
|
|
Unix.Unix_error _ -> "kill failed"
|
|
|
|
in
|
|
|
|
let s ex =
|
|
|
|
let data = Fmt.strf "%a %s %a" Name.pp id answer pp_process_exit ex in
|
|
|
|
reply (`String data)
|
|
|
|
in
|
2019-01-27 15:07:53 +00:00
|
|
|
Ok (t, `Wait (id, s))
|
2018-11-10 00:02:07 +00:00
|
|
|
|
|
|
|
let handle_block_cmd t reply id = function
|
|
|
|
| `Block_remove ->
|
2018-11-11 00:21:12 +00:00
|
|
|
Logs.debug (fun m -> m "removing block %a" Name.pp id) ;
|
2018-11-10 00:02:07 +00:00
|
|
|
begin match Vmm_resources.find_block t.resources id with
|
|
|
|
| None -> Error (`Msg "remove block: not found")
|
|
|
|
| Some (_, true) -> Error (`Msg "remove block: is in use")
|
|
|
|
| Some (_, false) ->
|
|
|
|
Vmm_unix.destroy_block id >>= fun () ->
|
|
|
|
Vmm_resources.remove_block t.resources id >>= fun resources ->
|
2019-01-27 15:07:53 +00:00
|
|
|
Ok ({ t with resources }, `End (reply (`String "removed block")))
|
2018-11-10 00:02:07 +00:00
|
|
|
end
|
|
|
|
| `Block_add size ->
|
|
|
|
begin
|
2018-11-11 00:21:12 +00:00
|
|
|
Logs.debug (fun m -> m "insert block %a: %dMB" Name.pp id size) ;
|
2018-11-10 00:02:07 +00:00
|
|
|
match Vmm_resources.find_block t.resources id with
|
|
|
|
| Some _ -> Error (`Msg "block device with same name already exists")
|
|
|
|
| None ->
|
2018-11-12 22:56:29 +00:00
|
|
|
Vmm_resources.check_block t.resources id size >>= fun () ->
|
|
|
|
Vmm_unix.create_block id size >>= fun () ->
|
|
|
|
Vmm_resources.insert_block t.resources id size >>= fun resources ->
|
2019-01-27 15:07:53 +00:00
|
|
|
Ok ({ t with resources }, `Loop (reply (`String "added block device")))
|
2018-11-10 00:02:07 +00:00
|
|
|
end
|
|
|
|
| `Block_info ->
|
2018-11-11 00:21:12 +00:00
|
|
|
Logs.debug (fun m -> m "block %a" Name.pp id) ;
|
2018-11-10 00:02:07 +00:00
|
|
|
let blocks =
|
2018-11-12 22:56:29 +00:00
|
|
|
Vmm_trie.fold id t.resources.Vmm_resources.block_devices
|
|
|
|
(fun prefix (size, active) blocks -> (prefix, size, active) :: blocks)
|
2018-11-10 00:02:07 +00:00
|
|
|
[]
|
|
|
|
in
|
|
|
|
match blocks with
|
|
|
|
| [] ->
|
2018-11-11 00:21:12 +00:00
|
|
|
Logs.debug (fun m -> m "block: couldn't find %a" Name.pp id) ;
|
2018-11-10 00:02:07 +00:00
|
|
|
Error (`Msg "block: not found")
|
|
|
|
| _ ->
|
2019-01-27 15:07:53 +00:00
|
|
|
Ok (t, `End (reply (`Block_devices blocks)))
|
2018-11-10 00:02:07 +00:00
|
|
|
|
2018-10-22 21:20:00 +00:00
|
|
|
let handle_command t (header, payload) =
|
2018-09-09 18:52:04 +00:00
|
|
|
let msg_to_err = function
|
2019-01-27 15:07:53 +00:00
|
|
|
| Ok x -> Ok x
|
2018-09-09 18:52:04 +00:00
|
|
|
| Error (`Msg msg) ->
|
2018-11-02 23:04:47 +00:00
|
|
|
Logs.err (fun m -> m "error while processing command: %s" msg) ;
|
2019-01-27 15:07:53 +00:00
|
|
|
Error (header, `Failure msg)
|
|
|
|
and reply x = (header, `Success x)
|
2018-11-11 00:21:12 +00:00
|
|
|
and id = header.Vmm_commands.name
|
2018-09-09 18:52:04 +00:00
|
|
|
in
|
|
|
|
msg_to_err (
|
2018-10-22 21:20:00 +00:00
|
|
|
match payload with
|
2018-11-10 00:02:07 +00:00
|
|
|
| `Command (`Policy_cmd pc) -> handle_policy_cmd t reply id pc
|
2019-10-10 23:10:33 +00:00
|
|
|
| `Command (`Unikernel_cmd vc) -> handle_unikernel_cmd t reply header id vc
|
2018-11-10 00:02:07 +00:00
|
|
|
| `Command (`Block_cmd bc) -> handle_block_cmd t reply id bc
|
2018-10-22 23:02:14 +00:00
|
|
|
| _ ->
|
2018-10-23 22:03:36 +00:00
|
|
|
Logs.err (fun m -> m "ignoring %a" Vmm_commands.pp_wire (header, payload)) ;
|
2018-10-22 23:02:14 +00:00
|
|
|
Error (`Msg "unknown command"))
|