2017-05-26 14:30:34 +00:00
|
|
|
(* (c) 2017 Hannes Mehnert, all rights reserved *)
|
|
|
|
|
2018-10-12 23:05:21 +00:00
|
|
|
(** A tree data structure including policies and dynamic usage.
|
2017-05-26 14:30:34 +00:00
|
|
|
|
|
|
|
Considering delegation of resources to someone, and further delegation
|
|
|
|
to others - using a process which is not controlled by the authority -
|
|
|
|
requires runtime tracking of these delegations and the actual usage:
|
|
|
|
|
|
|
|
If Alice may create 2 virtual machines, and she delegates the same
|
|
|
|
capability further to both Bob and Charlie, the authority must still enforce
|
|
|
|
that Alice, Bob, and Charlie are able to run 2 virtual machines in total,
|
|
|
|
rather than 2 each. *)
|
|
|
|
|
2018-11-12 22:56:29 +00:00
|
|
|
open Vmm_core
|
|
|
|
|
2017-05-26 14:30:34 +00:00
|
|
|
(** The type of the resource tree. *)
|
2018-11-12 22:56:29 +00:00
|
|
|
type t = private {
|
|
|
|
policies : Policy.t Vmm_trie.t ;
|
|
|
|
block_devices : (int * bool) Vmm_trie.t ;
|
2018-11-13 00:02:05 +00:00
|
|
|
unikernels : Unikernel.t Vmm_trie.t ;
|
2018-11-12 22:56:29 +00:00
|
|
|
}
|
|
|
|
|
2017-05-26 14:30:34 +00:00
|
|
|
|
|
|
|
(** [empty] is the empty tree. *)
|
|
|
|
val empty : t
|
|
|
|
|
|
|
|
(** [find_vm t id] is either [Some vm] or [None]. *)
|
2018-11-13 00:02:05 +00:00
|
|
|
val find_vm : t -> Name.t -> Unikernel.t option
|
2017-05-26 14:30:34 +00:00
|
|
|
|
2018-11-11 00:21:12 +00:00
|
|
|
(** [find_policy t Name.t] is either [Some policy] or [None]. *)
|
2018-11-12 22:56:29 +00:00
|
|
|
val find_policy : t -> Name.t -> Policy.t option
|
2018-10-28 18:41:06 +00:00
|
|
|
|
2018-11-11 00:21:12 +00:00
|
|
|
(** [find_block t Name.t] is either [Some (size, active)] or [None]. *)
|
2018-11-12 22:56:29 +00:00
|
|
|
val find_block : t -> Name.t -> (int * bool) option
|
2018-11-10 00:02:07 +00:00
|
|
|
|
2018-11-12 22:56:29 +00:00
|
|
|
(** [check_vm t Name.t vm] checks whether [vm] under [Name.t] in [t] would be
|
2018-10-12 23:05:21 +00:00
|
|
|
allowed under the current policies. *)
|
2018-11-13 00:02:05 +00:00
|
|
|
val check_vm : t -> Name.t -> Unikernel.config -> (unit, [> `Msg of string ]) result
|
2018-10-12 23:05:21 +00:00
|
|
|
|
2019-01-27 15:46:49 +00:00
|
|
|
(** [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
|
2017-05-26 14:30:34 +00:00
|
|
|
|
2018-11-11 00:21:12 +00:00
|
|
|
(** [insert_policy t Name.t policy] inserts [policy] under [Name.t] in [t], and returns
|
2018-10-12 23:05:21 +00:00
|
|
|
the new [t] or an error. *)
|
2018-11-12 22:56:29 +00:00
|
|
|
val insert_policy : t -> Name.t -> Policy.t -> (t, [> `Msg of string]) result
|
2017-05-26 14:30:34 +00:00
|
|
|
|
2018-11-12 22:56:29 +00:00
|
|
|
(** [check_block t Name.t size] checks whether [size] under [Name.t] in [t] would be
|
2018-11-10 00:02:07 +00:00
|
|
|
allowed under the current policies. *)
|
2018-11-12 22:56:29 +00:00
|
|
|
val check_block : t -> Name.t -> int -> (unit, [> `Msg of string ]) result
|
2018-11-10 00:02:07 +00:00
|
|
|
|
2018-11-11 00:21:12 +00:00
|
|
|
(** [insert_block t Name.t size] inserts [size] under [Name.t] in [t], and returns the new [t] or
|
2018-11-10 00:02:07 +00:00
|
|
|
an error. *)
|
2018-11-12 22:56:29 +00:00
|
|
|
val insert_block : t -> Name.t -> int -> (t, [> `Msg of string]) result
|
2018-11-10 00:02:07 +00:00
|
|
|
|
2018-11-11 00:21:12 +00:00
|
|
|
(** [remove_vm t Name.t] removes vm [Name.t] from [t]. *)
|
2018-11-12 22:56:29 +00:00
|
|
|
val remove_vm : t -> Name.t -> (t, [> `Msg of string ]) result
|
2018-10-28 18:50:48 +00:00
|
|
|
|
2018-11-11 00:21:12 +00:00
|
|
|
(** [remove_policy t Name.t] removes policy [Name.t] from [t]. *)
|
2018-11-12 22:56:29 +00:00
|
|
|
val remove_policy : t -> Name.t -> (t, [> `Msg of string ]) result
|
2017-05-26 14:30:34 +00:00
|
|
|
|
2018-11-11 00:21:12 +00:00
|
|
|
(** [remove_block t Name.t] removes block [Name.t] from [t]. *)
|
2018-11-12 22:56:29 +00:00
|
|
|
val remove_block : t -> Name.t -> (t, [> `Msg of string ]) result
|
2018-10-28 18:04:24 +00:00
|
|
|
|
|
|
|
(** [pp] is a pretty printer for [t]. *)
|
|
|
|
val pp : t Fmt.t
|