From a9c32d7801b6759bb9cac846a5fe28246c5884e6 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Sun, 27 Jan 2019 16:46:49 +0100 Subject: [PATCH] vmmd: actually, first check resources, then exec VM, then insert VM in case the insertion fails, raise Invalid_argument this leads to more sane failure behaviour, and also cleans up resources in case vmm_resources.insert_vm fails (or cpuset/open of the fifo, create_process) --- app/vmmd.ml | 5 +++-- src/vmm_resources.ml | 27 ++++++++++++--------------- src/vmm_resources.mli | 9 ++++++--- src/vmm_unix.ml | 2 +- src/vmm_vmmd.ml | 14 ++++++++++---- 5 files changed, 32 insertions(+), 25 deletions(-) diff --git a/app/vmmd.ml b/app/vmmd.ml index dce35cd..af40cc5 100644 --- a/app/vmmd.ml +++ b/app/vmmd.ml @@ -31,8 +31,9 @@ let create stat_out log_out cons_out data_out cons succ_cont fail_cont = data_out data | Ok () -> match succ_cont !state with | Error (`Msg msg) -> - Logs.err (fun m -> m "create continuation failed %s" msg) ; - Lwt.return_unit + Logs.err (fun m -> m "create (exec) failed %s" msg) ; + let data = fail_cont () in + data_out data | Ok (state', stat, log, data, name, vm) -> state := state' ; s := { !s with vm_created = succ !s.vm_created } ; diff --git a/src/vmm_resources.ml b/src/vmm_resources.ml index 1099128..f99ed5a 100644 --- a/src/vmm_resources.ml +++ b/src/vmm_resources.ml @@ -51,16 +51,15 @@ let find_block t name = Vmm_trie.find name t.block_devices let set_block_usage t name active = match Vmm_trie.find name t with - | None -> Error (`Msg "unknown block device") + | None -> invalid_arg ("block device " ^ Name.to_string name ^ " not in trie") | Some (size, curr) -> - if curr = active then - Error (`Msg "failed because the requested block usage was already set") - else - Ok (fst (Vmm_trie.insert name (size, active) t)) + if curr = active + then invalid_arg ("block device " ^ Name.to_string name ^ " already in state " ^ (if curr then "active" else "inactive")) + else fst (Vmm_trie.insert name (size, active) t) -let maybe_use_block t name vm active = +let use_block t name vm active = match vm.Unikernel.config.Unikernel.block_device with - | None -> Ok t + | None -> t | Some block -> let block_name = Name.block_name name block in set_block_usage t block_name active @@ -68,9 +67,9 @@ let maybe_use_block t name vm active = let remove_vm t name = match find_vm t name with | None -> Error (`Msg "unknown vm") | Some vm -> - maybe_use_block t.block_devices name vm false >>| fun block_devices -> + let block_devices = use_block t.block_devices name vm false in let unikernels = Vmm_trie.remove name t.unikernels in - { t with block_devices ; unikernels } + Ok { t with block_devices ; unikernels } let remove_policy t name = match find_policy t name with | None -> Error (`Msg "unknown policy") @@ -126,12 +125,10 @@ let check_vm t name vm = vm_ok let insert_vm t name vm = - check_vm t name vm.Unikernel.config >>= fun () -> - match Vmm_trie.insert name vm t.unikernels with - | unikernels, None -> - maybe_use_block t.block_devices name vm true >>| fun block_devices -> - { t with unikernels ; block_devices } - | _, Some _ -> Error (`Msg "vm already exists") + let unikernels, old = Vmm_trie.insert name vm t.unikernels in + (match old with None -> () | Some _ -> invalid_arg ("unikernel " ^ Name.to_string name ^ " already exists in trie")) ; + let block_devices = use_block t.block_devices name vm true in + { t with unikernels ; block_devices } let check_block t name size = let block_ok = match find_block t name with diff --git a/src/vmm_resources.mli b/src/vmm_resources.mli index dea627f..bee393f 100644 --- a/src/vmm_resources.mli +++ b/src/vmm_resources.mli @@ -37,9 +37,12 @@ val find_block : t -> Name.t -> (int * bool) option allowed under the current policies. *) val check_vm : t -> Name.t -> Unikernel.config -> (unit, [> `Msg of string ]) result -(** [insert_vm t Name.t vm] inserts [vm] under [Name.t] in [t], and returns the new [t] or - an error. *) -val insert_vm : t -> Name.t -> Unikernel.t -> (t, [> `Msg of string]) result +(** [insert_vm t Name.t vm] inserts [vm] under [Name.t] in [t], and returns the + new [t]. The caller has to ensure (using {!check_vm}) that a VM with the + same name does not yet exist, and the block device is not in use. + @raise Invalid_argument if block device is already in use, or VM already + exists. *) +val insert_vm : t -> Name.t -> Unikernel.t -> t (** [insert_policy t Name.t policy] inserts [policy] under [Name.t] in [t], and returns the new [t] or an error. *) diff --git a/src/vmm_unix.ml b/src/vmm_unix.ml index ed4b0b9..f867811 100644 --- a/src/vmm_unix.ml +++ b/src/vmm_unix.ml @@ -210,7 +210,7 @@ let exec name config taps block = Logs.debug (fun m -> m "created process %d: %a" pid Bos.Cmd.pp cmd) ; (* we gave a copy (well, two copies) of that file descriptor to the solo5 process and don't really need it here anymore... *) - close stdout ; + close_no_err stdout ; Ok Unikernel.{ config ; cmd ; pid ; taps } with Unix.Unix_error (e, _, _) -> diff --git a/src/vmm_vmmd.ml b/src/vmm_vmmd.ml index 594b0b0..26d0ee2 100644 --- a/src/vmm_vmmd.ml +++ b/src/vmm_vmmd.ml @@ -132,19 +132,25 @@ let handle_create t hdr name vm_config = (header, `Command (`Console_cmd `Console_add)) in let success t = - (* actually execute the vm *) + (* 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 *) let block_device = match vm_config.Unikernel.block_device with | None -> None | Some block -> Some (Name.block_name name block) in - Vmm_unix.exec name vm_config taps block_device >>= fun vm -> + Vmm_resources.check_vm t.resources name vm_config >>= fun () -> + Vmm_unix.exec name vm_config taps block_device >>| fun vm -> Logs.debug (fun m -> m "exec()ed vm") ; - Vmm_resources.insert_vm t.resources name vm >>= fun resources -> + let resources = Vmm_resources.insert_vm t.resources name vm in let t = { t with resources } in dump_unikernels t ; let t, log_out = log t name (`Unikernel_start (name, vm.Unikernel.pid, vm.Unikernel.taps, None)) in let t, stat_out = setup_stats t name vm in - Ok (t, stat_out, log_out, (hdr, `Success (`String "created VM")), name, vm) + (t, stat_out, log_out, (hdr, `Success (`String "created VM")), name, vm) and fail () = match Vmm_unix.free_resources name taps with | Ok () -> (hdr, `Failure "could not create VM: console failed")