gazagnaire.org
SpaceOS wire protocol codecs for host-guest communication
1open Wire
2
3type t = {
4 block_offset : int;
5 block_count : int;
6 dp_class : int;
7 priority : int;
8 name_len : int;
9 name : string;
10 crc32 : int;
11}
12
13let codec =
14 let open Codec in
15 record "DpPayload"
16 (fun block_offset block_count dp_class priority name_len name crc32 ->
17 { block_offset; block_count; dp_class; priority; name_len; name; crc32 })
18 |+ field "block_offset" uint32be (fun t -> t.block_offset)
19 |+ field "block_count" uint32be (fun t -> t.block_count)
20 |+ field "dp_class" uint16be (fun t -> t.dp_class)
21 |+ field "priority" uint8 (fun t -> t.priority)
22 |+ field "name_len" uint8 (fun t -> t.name_len)
23 |+ field "name" (byte_array ~size:(int 64)) (fun t -> t.name)
24 |+ field "crc32" uint32be (fun t -> t.crc32)
25 |> seal
26
27let v ~block_offset ~block_count ~dp_class ~priority ~name ~crc32 =
28 let name_len = min 64 (String.length name) in
29 { block_offset; block_count; dp_class; priority; name_len; name; crc32 }
30
31let name_string t = String.sub t.name 0 (min t.name_len (String.length t.name))
32
33let pp ppf t =
34 Fmt.pf ppf "@[<h>dp(off=%d count=%d class=%d pri=%d name=%S crc=0x%08x)@]"
35 t.block_offset t.block_count t.dp_class t.priority (name_string t) t.crc32
36
37let equal a b =
38 a.block_offset = b.block_offset
39 && a.block_count = b.block_count
40 && a.dp_class = b.dp_class && a.priority = b.priority
41 && a.name_len = b.name_len && String.equal a.name b.name && a.crc32 = b.crc32