reynir/albatross
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

drop version AV0, AV1; refactor vmm_asn

Browse source
This commit is contained in:
Hannes Mehnert 2018-10-28 22:52:20 +01:00
parent 0f9375dc29
commit 9191d2cf9a
3 changed files with 40 additions and 49 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

81
src/vmm_asn.ml
View file

@ -307,13 +307,9 @@ let policy_cmd =
let version =
let f data = match data with
| 0 -> `AV0
| 1 -> `AV1
| 2 -> `AV2
| _ -> Asn.S.error (`Parse "unknown version number")
and g = function
| `AV0 -> 0
| `AV1 -> 1
| `AV2 -> 2
in
Asn.S.map f g Asn.S.int
@ -376,55 +372,54 @@ let header =
(required ~label:"sequence" int64)
(required ~label:"id" (sequence_of utf8_string)))
let wire =
let f (header, payload) =
header,
match payload with
let success =
let f = function
| `C1 () -> `Empty
| `C2 str -> `String str
| `C3 policies -> `Policies policies
| `C4 vms -> `Vms vms
and g = function
| `Empty -> `C1 ()
| `String s -> `C2 s
| `Policies ps -> `C3 ps
| `Vms vms -> `C4 vms
in
Asn.S.map f g @@
Asn.S.(choice4
(explicit 0 null)
(explicit 1 utf8_string)
(explicit 2 (sequence_of
(sequence2
(required ~label:"name" (sequence_of utf8_string))
(required ~label:"policy" policy))))
(explicit 3 (sequence_of
(sequence2
(required ~label:"name" (sequence_of utf8_string))
(required ~label:"vm_config" vm_config)))))
let payload =
let f = function
| `C1 cmd -> `Command cmd
| `C2 data ->
let p = match data with
| `C1 () -> `Empty
| `C2 str -> `String str
| `C3 policies -> `Policies policies
| `C4 vms -> `Vms vms
in
`Success p
| `C2 s -> `Success s
| `C3 str -> `Failure str
| `C4 data -> `Data data
and g (header, payload) =
header,
match payload with
and g = function
| `Command cmd -> `C1 cmd
| `Success data ->
let p = match data with
| `Empty -> `C1 ()
| `String s -> `C2 s
| `Policies ps -> `C3 ps
| `Vms vms -> `C4 vms
in
`C2 p
| `Success s -> `C2 s
| `Failure str -> `C3 str
| `Data d -> `C4 d
in
Asn.S.map f g @@
Asn.S.(choice4
(explicit 0 wire_command)
(explicit 1 success)
(explicit 2 utf8_string)
(explicit 3 data))
let wire =
Asn.S.(sequence2
(required ~label:"header" header)
(required ~label:"payload"
(choice4
(explicit 0 wire_command)
(explicit 1 (choice4
(explicit 0 null)
(explicit 1 utf8_string)
(explicit 2 (sequence_of
(sequence2
(required ~label:"name" (sequence_of utf8_string))
(required ~label:"policy" policy))))
(explicit 3 (sequence_of
(sequence2
(required ~label:"name" (sequence_of utf8_string))
(required ~label:"vm_config" vm_config))))))
(explicit 2 utf8_string)
(explicit 3 data))))
(required ~label:"payload" payload))
let wire_of_cstruct, wire_to_cstruct = projections_of wire

6
src/vmm_commands.ml
View file

@ -3,19 +3,15 @@
(* the wire protocol *)
open Vmm_core
type version = [ `AV0 | `AV1 | `AV2 ]
type version = [ `AV2 ]
let pp_version ppf v =
Fmt.int ppf
(match v with
| `AV0 -> 0
| `AV1 -> 1
| `AV2 -> 2)
let version_eq a b =
match a, b with
| `AV0, `AV0 -> true
| `AV1, `AV1 -> true
| `AV2, `AV2 -> true
| _ -> false

2
src/vmm_commands.mli
View file

@ -3,7 +3,7 @@
open Vmm_core
(** The type of versions of the grammar defined below. *)
type version = [ `AV0 | `AV1 | `AV2 ]
type version = [ `AV2 ]
(** [version_eq a b] is true if [a] and [b] are equal. *)
val version_eq : version -> version -> bool