preserve backwards data compatibility

This commit is contained in:
Hannes Mehnert 2019-10-15 00:49:58 +02:00
parent 5b187999f1
commit 47fef438e0

View file

@ -104,6 +104,8 @@ let ru =
@ (required ~label:"nvcsw" int64) @ (required ~label:"nvcsw" int64)
-@ (required ~label:"nivcsw" 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 kinfo_mem =
let open Stats in let open Stats in
let f (vsize, (rss, (tsize, (dsize, (ssize, (runtime, (cow, start))))))) = let f (vsize, (rss, (tsize, (dsize, (ssize, (runtime, (cow, start))))))) =
@ -187,42 +189,53 @@ let of_name, to_name =
| Ok name -> name | Ok name -> name
let log_event = let log_event =
(* this is stored on disk persistently -- be aware when changing the grammar
below to only ever extend it! *)
let f = function let f = function
| `C1 () -> `Startup | `C1 `C1 () -> `Startup
| `C2 (name, ip, port) -> `Login (to_name name, ip, port) | `C1 `C2 (name, ip, port) -> `Login (to_name name, ip, port)
| `C3 (name, ip, port) -> `Logout (to_name name, ip, port) | `C1 `C3 (name, ip, port) -> `Logout (to_name name, ip, port)
| `C4 (name, pid, taps, blocks) -> | `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) -> let blocks = List.map (fun (name, dev) ->
name, match Name.of_string dev with name, match Name.of_string dev with
| Error `Msg msg -> Asn.S.error (`Parse msg) | Error `Msg msg -> Asn.S.error (`Parse msg)
| Ok id -> id) blocks | Ok id -> id) blocks
in in
`Unikernel_start (to_name name, pid, taps, blocks) `Unikernel_start (to_name name, pid, taps, blocks)
| `C5 (name, pid, status) -> | `C1 `C5 (name, pid, status) ->
let status' = match status with let status' = match status with
| `C1 n -> `Exit n | `C1 n -> `Exit n
| `C2 n -> `Signal n | `C2 n -> `Signal n
| `C3 n -> `Stop n | `C3 n -> `Stop n
in in
`Unikernel_stop (to_name name, pid, status') `Unikernel_stop (to_name name, pid, status')
| `C6 () -> `Hup | `C1 `C6 () -> `Hup
| `C2 `C2 () -> assert false (* placeholder *)
and g = function and g = function
| `Startup -> `C1 () | `Startup -> `C1 (`C1 ())
| `Login (name, ip, port) -> `C2 (of_name name, ip, port) | `Login (name, ip, port) -> `C1 (`C2 (of_name name, ip, port))
| `Logout (name, ip, port) -> `C3 (of_name name, ip, port) | `Logout (name, ip, port) -> `C1 (`C3 (of_name name, ip, port))
| `Unikernel_start (name, pid, taps, blocks) -> | `Unikernel_start (name, pid, taps, blocks) ->
let blocks = let blocks =
List.map (fun (name, dev) -> name, Name.to_string dev) blocks List.map (fun (name, dev) -> name, Name.to_string dev) blocks
in in
`C4 (of_name name, pid, taps, blocks) `C2 (`C1 (of_name name, pid, taps, blocks))
| `Unikernel_stop (name, pid, status) -> | `Unikernel_stop (name, pid, status) ->
let status' = match status with let status' = match status with
| `Exit n -> `C1 n | `Exit n -> `C1 n
| `Signal n -> `C2 n | `Signal n -> `C2 n
| `Stop n -> `C3 n | `Stop n -> `C3 n
in in
`C5 (of_name name, pid, status') `C1 (`C5 (of_name name, pid, status'))
| `Hup -> `C6 () | `Hup -> `C1 (`C6 ())
in in
let endp = let endp =
Asn.S.(sequence3 Asn.S.(sequence3
@ -231,31 +244,42 @@ let log_event =
(required ~label:"port" int)) (required ~label:"port" int))
in in
Asn.S.map f g @@ Asn.S.map f g @@
Asn.S.(choice6 Asn.S.(choice2
(explicit 0 null) (choice6
(explicit 1 endp) (explicit 0 null)
(explicit 2 endp) (explicit 1 endp)
(explicit 3 (sequence4 (explicit 2 endp)
(required ~label:"name" (sequence_of utf8_string)) (* the old V3 unikernel start *)
(required ~label:"pid" int) (explicit 3 (sequence4
(required ~label:"taps" (required ~label:"name" (sequence_of utf8_string))
(sequence_of (required ~label:"pid" int)
(sequence2 (required ~label:"taps" (sequence_of utf8_string))
(required ~label:"bridge" utf8_string) (optional ~label:"block" utf8_string)))
(required ~label:"tap" utf8_string)))) (explicit 4 (sequence3
(required ~label:"blocks" (required ~label:"name" (sequence_of utf8_string))
(sequence_of (required ~label:"pid" int)
(sequence2 (required ~label:"status" (choice3
(required ~label:"name" utf8_string) (explicit 0 int)
(required ~label:"device" utf8_string)))))) (explicit 1 int)
(explicit 4 (sequence3 (explicit 2 int)))))
(required ~label:"name" (sequence_of utf8_string)) (explicit 5 null))
(required ~label:"pid" int) (choice2
(required ~label:"status" (choice3 (* the new V4 unikernel start*)
(explicit 0 int) (explicit 6 (sequence4
(explicit 1 int) (required ~label:"name" (sequence_of utf8_string))
(explicit 2 int))))) (required ~label:"pid" int)
(explicit 5 null)) (required ~label:"taps"
(sequence_of
(sequence2
(required ~label:"bridge" utf8_string)
(required ~label:"tap" utf8_string))))
(required ~label:"blocks"
(sequence_of
(sequence2
(required ~label:"name" utf8_string)
(required ~label:"device" utf8_string))))))
(explicit 7 null)))
let log_cmd = let log_cmd =
let f = function let f = function
@ -299,6 +323,55 @@ let fail_behaviour =
(explicit 0 null) (explicit 0 null)
(explicit 1 (set_of int))) (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 unikernel_config =
let open Unikernel in let open Unikernel in
let f (typ, (compressed, (image, (fail_behaviour, (cpuid, (memory, (blocks, (bridges, argv)))))))) = 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 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 = let log_entry =
Asn.S.(sequence2 Asn.S.(sequence2
(required ~label:"timestamp" utc_time) (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 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 (* data is persisted to disk, we need to ensure to be able to decode (and
is always the version, we can dispatch on it for the later reader encode) properly without conflicts! *)
-- 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 ;)
*)
let log_disk = let log_disk =
Asn.S.(sequence2 Asn.S.(sequence2
(required ~label:"version" version) (required ~label:"version" version)
@ -584,20 +631,22 @@ let trie e =
(required ~label:"name" utf8_string) (required ~label:"name" utf8_string)
(required ~label:"value" e))) (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 = let unikernels =
(* the choice is the implicit version + migration... be aware when (* the choice is the implicit version + migration... be aware when
any dependent data layout changes .oO(/o\) *) any dependent data layout changes .oO(/o\) *)
let f = function let f = function
| `C1 () -> Asn.S.error (`Parse "shouldn't happen") | `C1 data -> data
| `C2 data -> data | `C2 data -> data
and g data = and g data =
`C2 data `C1 data
in in
Asn.S.map f g @@ Asn.S.map f g @@
Asn.S.(choice2 Asn.S.(choice2
(explicit 0 null) (explicit 0 version1_unikernels)
(explicit 1 version0_unikernels)) (explicit 1 version0_unikernels))
let unikernels_of_cstruct, unikernels_to_cstruct = projections_of unikernels let unikernels_of_cstruct, unikernels_to_cstruct = projections_of unikernels