re-support parsing of AV2 log entries, document path forward strategy

This commit is contained in:
Hannes Mehnert 2018-12-06 22:55:13 +01:00
parent e28ea84548
commit bda342f136
5 changed files with 19 additions and 14 deletions

View file

@ -31,7 +31,7 @@ let write_complete s cs =
let read_from_file file =
Vmm_lwt.read_from_file file >|= fun data ->
let logs = Vmm_asn.logs_of_disk my_version data in
let logs = Vmm_asn.logs_of_disk data in
List.rev logs
let write_to_file file =

View file

@ -313,9 +313,11 @@ let block_cmd =
let version =
let f data = match data with
| 3 -> `AV3
| 2 -> `AV2
| x -> Asn.S.error (`Parse (Printf.sprintf "unknown version number 0x%X" x))
and g = function
| `AV3 -> 3
| `AV2 -> 2
in
Asn.S.map f g Asn.S.int
@ -445,6 +447,12 @@ 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 ;)
*)
let log_disk =
Asn.S.(sequence2
(required ~label:"version" version)
@ -457,17 +465,12 @@ let log_disk_of_cstruct, log_disk_to_cstruct =
let log_to_disk version entry =
log_disk_to_cstruct (version, entry)
let logs_of_disk version buf =
let logs_of_disk buf =
let rec next acc buf =
match log_disk_of_cstruct buf with
| Ok ((version', entry), cs) ->
let acc' =
if Vmm_commands.version_eq version version' then
entry :: acc
else
acc
in
next acc' cs
| Ok ((version, entry), cs) ->
Logs.info (fun m -> m "read a log entry version %a" pp_version version) ;
next (entry :: acc) cs
| Error (`Parse msg) ->
Logs.warn (fun m -> m "parse error %s while parsing log" msg) ;
acc (* ignore *)

View file

@ -19,7 +19,7 @@ val log_entry_of_cstruct : Cstruct.t -> (Log.t, [> `Msg of string ]) result
val log_to_disk : Vmm_commands.version -> Log.t -> Cstruct.t
val logs_of_disk : Vmm_commands.version -> Cstruct.t -> Log.t list
val logs_of_disk : Cstruct.t -> Log.t list
type cert_extension = Vmm_commands.version * Vmm_commands.t

View file

@ -3,16 +3,18 @@
(* the wire protocol *)
open Vmm_core
type version = [ `AV3 ]
type version = [ `AV2 | `AV3 ]
let pp_version ppf v =
Fmt.int ppf
(match v with
| `AV3 -> 3)
| `AV3 -> 3
| `AV2 -> 2)
let version_eq a b =
match a, b with
| `AV3, `AV3 -> true
| `AV2, `AV2 -> true
| _ -> false
type console_cmd = [

View file

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