preserve backwards data compatibility
This commit is contained in:
Hannes Mehnert
parent
5b187999f1
commit
47fef438e0
155
src/vmm_asn.ml
155
src/vmm_asn.ml
|
|
@ -104,6 +104,8 @@ let ru =
|
|||
@ (required ~label:"nvcsw" int64)
|
||||
-@ (required ~label:"nivcsw" int64))
|
||||
|
||||
(* although this changed (+runtime + cow + start) from V3 to V4, since it's not
|
||||
persistent, no need to care about it *)
|
||||
let kinfo_mem =
|
||||
let open Stats in
|
||||
let f (vsize, (rss, (tsize, (dsize, (ssize, (runtime, (cow, start))))))) =
|
||||
|
|
@ -187,42 +189,53 @@ let of_name, to_name =
|
|||
| Ok name -> name
|
||||
|
||||
let log_event =
|
||||
(* this is stored on disk persistently -- be aware when changing the grammar
|
||||
below to only ever extend it! *)
|
||||
let f = function
|
||||
| `C1 () -> `Startup
|
||||
| `C2 (name, ip, port) -> `Login (to_name name, ip, port)
|
||||
| `C3 (name, ip, port) -> `Logout (to_name name, ip, port)
|
||||
| `C4 (name, pid, taps, blocks) ->
|
||||
| `C1 `C1 () -> `Startup
|
||||
| `C1 `C2 (name, ip, port) -> `Login (to_name name, ip, port)
|
||||
| `C1 `C3 (name, ip, port) -> `Logout (to_name name, ip, port)
|
||||
| `C1 `C4 (name, pid, taps, block) ->
|
||||
let name = to_name name in
|
||||
let blocks = match block with
|
||||
| None -> []
|
||||
| Some block -> [ block, Name.block_name name block ]
|
||||
and taps = List.map (fun tap -> tap, tap) taps
|
||||
in
|
||||
`Unikernel_start (name, pid, taps, blocks)
|
||||
| `C2 `C1 (name, pid, taps, blocks) ->
|
||||
let blocks = List.map (fun (name, dev) ->
|
||||
name, match Name.of_string dev with
|
||||
| Error `Msg msg -> Asn.S.error (`Parse msg)
|
||||
| Ok id -> id) blocks
|
||||
in
|
||||
`Unikernel_start (to_name name, pid, taps, blocks)
|
||||
| `C5 (name, pid, status) ->
|
||||
| `C1 `C5 (name, pid, status) ->
|
||||
let status' = match status with
|
||||
| `C1 n -> `Exit n
|
||||
| `C2 n -> `Signal n
|
||||
| `C3 n -> `Stop n
|
||||
in
|
||||
`Unikernel_stop (to_name name, pid, status')
|
||||
| `C6 () -> `Hup
|
||||
| `C1 `C6 () -> `Hup
|
||||
| `C2 `C2 () -> assert false (* placeholder *)
|
||||
and g = function
|
||||
| `Startup -> `C1 ()
|
||||
| `Login (name, ip, port) -> `C2 (of_name name, ip, port)
|
||||
| `Logout (name, ip, port) -> `C3 (of_name name, ip, port)
|
||||
| `Startup -> `C1 (`C1 ())
|
||||
| `Login (name, ip, port) -> `C1 (`C2 (of_name name, ip, port))
|
||||
| `Logout (name, ip, port) -> `C1 (`C3 (of_name name, ip, port))
|
||||
| `Unikernel_start (name, pid, taps, blocks) ->
|
||||
let blocks =
|
||||
List.map (fun (name, dev) -> name, Name.to_string dev) blocks
|
||||
in
|
||||
`C4 (of_name name, pid, taps, blocks)
|
||||
`C2 (`C1 (of_name name, pid, taps, blocks))
|
||||
| `Unikernel_stop (name, pid, status) ->
|
||||
let status' = match status with
|
||||
| `Exit n -> `C1 n
|
||||
| `Signal n -> `C2 n
|
||||
| `Stop n -> `C3 n
|
||||
in
|
||||
`C5 (of_name name, pid, status')
|
||||
| `Hup -> `C6 ()
|
||||
`C1 (`C5 (of_name name, pid, status'))
|
||||
| `Hup -> `C1 (`C6 ())
|
||||
in
|
||||
let endp =
|
||||
Asn.S.(sequence3
|
||||
|
|
@ -231,11 +244,28 @@ let log_event =
|
|||
(required ~label:"port" int))
|
||||
in
|
||||
Asn.S.map f g @@
|
||||
Asn.S.(choice6
|
||||
Asn.S.(choice2
|
||||
(choice6
|
||||
(explicit 0 null)
|
||||
(explicit 1 endp)
|
||||
(explicit 2 endp)
|
||||
(* the old V3 unikernel start *)
|
||||
(explicit 3 (sequence4
|
||||
(required ~label:"name" (sequence_of utf8_string))
|
||||
(required ~label:"pid" int)
|
||||
(required ~label:"taps" (sequence_of utf8_string))
|
||||
(optional ~label:"block" utf8_string)))
|
||||
(explicit 4 (sequence3
|
||||
(required ~label:"name" (sequence_of utf8_string))
|
||||
(required ~label:"pid" int)
|
||||
(required ~label:"status" (choice3
|
||||
(explicit 0 int)
|
||||
(explicit 1 int)
|
||||
(explicit 2 int)))))
|
||||
(explicit 5 null))
|
||||
(choice2
|
||||
(* the new V4 unikernel start*)
|
||||
(explicit 6 (sequence4
|
||||
(required ~label:"name" (sequence_of utf8_string))
|
||||
(required ~label:"pid" int)
|
||||
(required ~label:"taps"
|
||||
|
|
@ -248,14 +278,8 @@ let log_event =
|
|||
(sequence2
|
||||
(required ~label:"name" utf8_string)
|
||||
(required ~label:"device" utf8_string))))))
|
||||
(explicit 4 (sequence3
|
||||
(required ~label:"name" (sequence_of utf8_string))
|
||||
(required ~label:"pid" int)
|
||||
(required ~label:"status" (choice3
|
||||
(explicit 0 int)
|
||||
(explicit 1 int)
|
||||
(explicit 2 int)))))
|
||||
(explicit 5 null))
|
||||
(explicit 7 null)))
|
||||
|
||||
|
||||
let log_cmd =
|
||||
let f = function
|
||||
|
|
@ -299,6 +323,55 @@ let fail_behaviour =
|
|||
(explicit 0 null)
|
||||
(explicit 1 (set_of int)))
|
||||
|
||||
(* this is part of the state file! *)
|
||||
let v3_unikernel_config =
|
||||
let image =
|
||||
let f = function
|
||||
| `C1 x -> `Hvt_amd64, x
|
||||
| `C2 x -> `Hvt_arm64, x
|
||||
| `C3 x -> `Hvt_amd64_compressed, x
|
||||
and g = function
|
||||
| `Hvt_amd64, x -> `C1 x
|
||||
| `Hvt_arm64, x -> `C2 x
|
||||
| `Hvt_amd64_compressed, x -> `C3 x
|
||||
in
|
||||
Asn.S.map f g @@
|
||||
Asn.S.(choice3
|
||||
(explicit 0 octet_string)
|
||||
(explicit 1 octet_string)
|
||||
(explicit 2 octet_string))
|
||||
in
|
||||
let open Unikernel in
|
||||
let f (cpuid, memory, block_device, network_interfaces, image, argv) =
|
||||
let bridges = match network_interfaces with None -> [] | Some xs -> xs
|
||||
and block_devices = match block_device with None -> [] | Some b -> [ b ]
|
||||
in
|
||||
let typ = `Solo5
|
||||
and compressed = match fst image with `Hvt_amd64_compressed -> true | _ -> false
|
||||
and image = snd image
|
||||
and fail_behaviour = `Quit
|
||||
in
|
||||
{ typ ; compressed ; image ; fail_behaviour ; cpuid ; memory ; block_devices ; bridges ; argv }
|
||||
and g vm =
|
||||
let network_interfaces = match vm.bridges with [] -> None | xs -> Some xs
|
||||
and block_device = match vm.block_devices with [] -> None | x::_ -> Some x
|
||||
and typ = if vm.compressed then `Hvt_amd64_compressed else `Hvt_amd64
|
||||
in
|
||||
let image = typ, vm.image in
|
||||
(vm.cpuid, vm.memory, block_device, network_interfaces, image, vm.argv)
|
||||
in
|
||||
Asn.S.map f g @@
|
||||
Asn.S.(sequence6
|
||||
(required ~label:"cpu" int)
|
||||
(required ~label:"memory" int)
|
||||
(optional ~label:"block" utf8_string)
|
||||
(optional ~label:"network_interfaces" (sequence_of utf8_string))
|
||||
(required ~label:"image" image)
|
||||
(optional ~label:"arguments" (sequence_of utf8_string)))
|
||||
|
||||
|
||||
(* this is part of the state file (and unikernel_create command)
|
||||
be aware if this (or a dependent grammar) is changed! *)
|
||||
let unikernel_config =
|
||||
let open Unikernel in
|
||||
let f (typ, (compressed, (image, (fail_behaviour, (cpuid, (memory, (blocks, (bridges, argv)))))))) =
|
||||
|
|
@ -507,28 +580,6 @@ let wire =
|
|||
|
||||
let wire_of_cstruct, wire_to_cstruct = projections_of wire
|
||||
|
||||
(* maybe one day to smoothly transition to a new version,
|
||||
but this requires version handshaking in all communication (i.e. server
|
||||
sends: supported versions, client picks one to talk over this channel)
|
||||
let payload_of_cstruct, _ = projections_of payload
|
||||
let wire_of_cstruct versions buf =
|
||||
let wire_header =
|
||||
Asn.S.(sequence2
|
||||
(required ~label:"header" header)
|
||||
(required ~label:"payload" octet_string))
|
||||
in
|
||||
let wire_header_of_cstruct, _ = projections_of wire_header in
|
||||
match wire_header_of_cstruct buf with
|
||||
| Error e -> Error e
|
||||
| Ok (header, payload) ->
|
||||
if List.mem header.version versions then
|
||||
match payload_of_cstruct payload with
|
||||
| Ok p -> Ok (header, p)
|
||||
| Error e -> Error e
|
||||
else
|
||||
Error (`Msg "unsupported version")
|
||||
*)
|
||||
|
||||
let log_entry =
|
||||
Asn.S.(sequence2
|
||||
(required ~label:"timestamp" utc_time)
|
||||
|
|
@ -536,12 +587,8 @@ let log_entry =
|
|||
|
||||
let log_entry_of_cstruct, log_entry_to_cstruct = projections_of log_entry
|
||||
|
||||
(* if we revise structure, we need to stay in a sequence.. the first element
|
||||
is always the version, we can dispatch on it for the later reader
|
||||
-- would be easier to use a choice here -- we can define implicit tagged
|
||||
is the current structure, and then 1 for new format etc.
|
||||
keep in mind while changing arbitrary data here which may end up in the log ;)
|
||||
*)
|
||||
(* data is persisted to disk, we need to ensure to be able to decode (and
|
||||
encode) properly without conflicts! *)
|
||||
let log_disk =
|
||||
Asn.S.(sequence2
|
||||
(required ~label:"version" version)
|
||||
|
|
@ -584,20 +631,22 @@ let trie e =
|
|||
(required ~label:"name" utf8_string)
|
||||
(required ~label:"value" e)))
|
||||
|
||||
let version0_unikernels = trie unikernel_config
|
||||
let version0_unikernels = trie v3_unikernel_config
|
||||
|
||||
let version1_unikernels = trie unikernel_config
|
||||
|
||||
let unikernels =
|
||||
(* the choice is the implicit version + migration... be aware when
|
||||
any dependent data layout changes .oO(/o\) *)
|
||||
let f = function
|
||||
| `C1 () -> Asn.S.error (`Parse "shouldn't happen")
|
||||
| `C1 data -> data
|
||||
| `C2 data -> data
|
||||
and g data =
|
||||
`C2 data
|
||||
`C1 data
|
||||
in
|
||||
Asn.S.map f g @@
|
||||
Asn.S.(choice2
|
||||
(explicit 0 null)
|
||||
(explicit 0 version1_unikernels)
|
||||
(explicit 1 version0_unikernels))
|
||||
|
||||
let unikernels_of_cstruct, unikernels_to_cstruct = projections_of unikernels
|
||||
|
|
|
|||
Loading…
Reference in a new issue