gazagnaire.org
SpaceOS wire protocol codecs for host-guest communication
1open Wire
2
3let frame_size = 256
4let header_size = 8
5let max_payload = frame_size - header_size
6
7type kind =
8 | TM
9 | TC
10 | EVR
11 | PRM_GET
12 | PRM_SET
13 | PRM_RSP
14 | DP
15 | HEALTH
16 | LOG
17 | ERROR
18
19let kind_to_int = function
20 | TM -> 0x00
21 | TC -> 0x01
22 | EVR -> 0x02
23 | PRM_GET -> 0x03
24 | PRM_SET -> 0x04
25 | PRM_RSP -> 0x05
26 | DP -> 0x06
27 | HEALTH -> 0x07
28 | LOG -> 0x08
29 | ERROR -> 0x09
30
31let kind_of_int = function
32 | 0x00 -> Some TM
33 | 0x01 -> Some TC
34 | 0x02 -> Some EVR
35 | 0x03 -> Some PRM_GET
36 | 0x04 -> Some PRM_SET
37 | 0x05 -> Some PRM_RSP
38 | 0x06 -> Some DP
39 | 0x07 -> Some HEALTH
40 | 0x08 -> Some LOG
41 | 0x09 -> Some ERROR
42 | _ -> None
43
44let pp_kind ppf = function
45 | TM -> Fmt.string ppf "TM"
46 | TC -> Fmt.string ppf "TC"
47 | EVR -> Fmt.string ppf "EVR"
48 | PRM_GET -> Fmt.string ppf "PRM_GET"
49 | PRM_SET -> Fmt.string ppf "PRM_SET"
50 | PRM_RSP -> Fmt.string ppf "PRM_RSP"
51 | DP -> Fmt.string ppf "DP"
52 | HEALTH -> Fmt.string ppf "HEALTH"
53 | LOG -> Fmt.string ppf "LOG"
54 | ERROR -> Fmt.string ppf "ERROR"
55
56type t = {
57 version : int;
58 msg_type : int;
59 apid : int;
60 payload_length : int;
61 reserved : int;
62 payload : string;
63}
64
65let codec =
66 let open Codec in
67 record "SpaceOSFrame"
68 (fun version msg_type apid payload_length reserved payload ->
69 { version; msg_type; apid; payload_length; reserved; payload })
70 |+ field "version" uint8 (fun t -> t.version)
71 |+ field "msg_type" uint8 (fun t -> t.msg_type)
72 |+ field "apid" uint16be (fun t -> t.apid)
73 |+ field "payload_length" uint16be (fun t -> t.payload_length)
74 |+ field "reserved" uint16be (fun t -> t.reserved)
75 |+ field "payload" (byte_array ~size:(int max_payload)) (fun t -> t.payload)
76 |> seal
77
78let v typ ~apid payload =
79 let payload_length = min max_payload (String.length payload) in
80 (* Pad payload to full 248 bytes for exact roundtrip *)
81 let padded = Bytes.make max_payload '\x00' in
82 Bytes.blit_string payload 0 padded 0 payload_length;
83 {
84 version = 0x01;
85 msg_type = kind_to_int typ;
86 apid;
87 payload_length;
88 reserved = 0;
89 payload = Bytes.unsafe_to_string padded;
90 }
91
92let payload_bytes t =
93 let n = max 0 (min max_payload t.payload_length) in
94 String.sub t.payload 0 n
95
96let pp ppf t =
97 let typ_s =
98 match kind_of_int t.msg_type with
99 | Some mt -> Fmt.str "%a" pp_kind mt
100 | None -> Fmt.str "0x%02x" t.msg_type
101 in
102 Fmt.pf ppf "@[<h>frame(ver=%d type=%s apid=%d payload=%d)@]" t.version typ_s
103 t.apid t.payload_length
104
105let equal a b =
106 a.version = b.version && a.msg_type = b.msg_type && a.apid = b.apid
107 && a.payload_length = b.payload_length
108 && a.reserved = b.reserved
109 && String.equal a.payload b.payload