2018-10-23 22:13:47 +00:00
|
|
|
(* (c) 2018 Hannes Mehnert, all rights reserved *)
|
|
|
|
|
2018-10-23 22:03:36 +00:00
|
|
|
open Vmm_core
|
|
|
|
|
|
|
|
(** The type of versions of the grammar defined below. *)
|
2019-11-11 20:49:51 +00:00
|
|
|
type version = [ `AV3 | `AV4 ]
|
2018-10-23 22:03:36 +00:00
|
|
|
|
2019-11-11 20:49:51 +00:00
|
|
|
(** [current] is the current version. *)
|
|
|
|
val current : version
|
|
|
|
|
|
|
|
val is_current : version -> bool
|
2018-10-23 22:03:36 +00:00
|
|
|
|
|
|
|
(** [pp_version ppf version] pretty prints [version] onto [ppf]. *)
|
|
|
|
val pp_version : version Fmt.t
|
|
|
|
|
2019-10-29 18:42:55 +00:00
|
|
|
type since_count = [ `Since of Ptime.t | `Count of int ]
|
|
|
|
|
2018-10-23 22:03:36 +00:00
|
|
|
type console_cmd = [
|
|
|
|
| `Console_add
|
2019-10-29 18:42:55 +00:00
|
|
|
| `Console_subscribe of since_count
|
2018-10-23 22:03:36 +00:00
|
|
|
]
|
|
|
|
|
|
|
|
type stats_cmd = [
|
2019-01-14 23:25:59 +00:00
|
|
|
| `Stats_add of string * int * (string * string) list
|
2018-10-23 22:03:36 +00:00
|
|
|
| `Stats_remove
|
|
|
|
| `Stats_subscribe
|
|
|
|
]
|
|
|
|
|
|
|
|
type log_cmd = [
|
2019-10-29 18:42:55 +00:00
|
|
|
| `Log_subscribe of since_count
|
2018-10-23 22:03:36 +00:00
|
|
|
]
|
|
|
|
|
2018-11-13 00:02:05 +00:00
|
|
|
type unikernel_cmd = [
|
|
|
|
| `Unikernel_info
|
|
|
|
| `Unikernel_create of Unikernel.config
|
|
|
|
| `Unikernel_force_create of Unikernel.config
|
|
|
|
| `Unikernel_destroy
|
2020-07-05 19:27:44 +00:00
|
|
|
| `Unikernel_get
|
2018-10-23 22:03:36 +00:00
|
|
|
]
|
|
|
|
|
|
|
|
type policy_cmd = [
|
|
|
|
| `Policy_info
|
2018-11-11 02:09:37 +00:00
|
|
|
| `Policy_add of Policy.t
|
2018-10-23 22:03:36 +00:00
|
|
|
| `Policy_remove
|
|
|
|
]
|
|
|
|
|
2018-11-10 00:02:07 +00:00
|
|
|
type block_cmd = [
|
|
|
|
| `Block_info
|
|
|
|
| `Block_add of int
|
|
|
|
| `Block_remove
|
|
|
|
]
|
|
|
|
|
2018-10-23 22:03:36 +00:00
|
|
|
type t = [
|
|
|
|
| `Console_cmd of console_cmd
|
|
|
|
| `Stats_cmd of stats_cmd
|
|
|
|
| `Log_cmd of log_cmd
|
2018-11-13 00:02:05 +00:00
|
|
|
| `Unikernel_cmd of unikernel_cmd
|
2018-11-10 00:02:07 +00:00
|
|
|
| `Policy_cmd of policy_cmd
|
|
|
|
| `Block_cmd of block_cmd
|
|
|
|
]
|
2018-10-23 22:03:36 +00:00
|
|
|
|
|
|
|
val pp : t Fmt.t
|
|
|
|
|
|
|
|
type data = [
|
|
|
|
| `Console_data of Ptime.t * string
|
|
|
|
| `Stats_data of Stats.t
|
|
|
|
| `Log_data of Log.t
|
|
|
|
]
|
|
|
|
|
|
|
|
val pp_data : data Fmt.t
|
|
|
|
|
|
|
|
type header = {
|
|
|
|
version : version ;
|
|
|
|
sequence : int64 ;
|
2018-11-11 00:21:12 +00:00
|
|
|
name : Name.t ;
|
2018-10-23 22:03:36 +00:00
|
|
|
}
|
|
|
|
|
2019-11-11 20:49:51 +00:00
|
|
|
val header : ?version:version -> ?sequence:int64 -> Name.t -> header
|
|
|
|
|
2018-10-23 22:03:36 +00:00
|
|
|
type success = [
|
|
|
|
| `Empty
|
|
|
|
| `String of string
|
2018-11-11 02:09:37 +00:00
|
|
|
| `Policies of (Name.t * Policy.t) list
|
2018-11-13 00:02:05 +00:00
|
|
|
| `Unikernels of (Name.t * Unikernel.config) list
|
|
|
|
| `Block_devices of (Name.t * int * bool) list
|
2018-10-23 22:03:36 +00:00
|
|
|
]
|
|
|
|
|
2019-11-11 20:49:51 +00:00
|
|
|
type res = [
|
|
|
|
| `Command of t
|
|
|
|
| `Success of success
|
|
|
|
| `Failure of string
|
|
|
|
| `Data of data
|
|
|
|
]
|
|
|
|
|
|
|
|
type wire = header * res
|
2018-10-23 22:03:36 +00:00
|
|
|
|
|
|
|
val pp_wire : wire Fmt.t
|
|
|
|
|
|
|
|
val endpoint : t -> service * [ `End | `Read ]
|