gazagnaire.org
SpaceOS wire protocol codecs for host-guest communication
1open Wire
2
3let max_payload_len = 64
4let record_size = 76
5
6type severity = DEBUG | INFO | WARNING | ERROR | FATAL
7
8let severity_to_int = function
9 | DEBUG -> 0
10 | INFO -> 1
11 | WARNING -> 2
12 | ERROR -> 3
13 | FATAL -> 4
14
15let severity_of_int = function
16 | 0 -> Some DEBUG
17 | 1 -> Some INFO
18 | 2 -> Some WARNING
19 | 3 -> Some ERROR
20 | 4 -> Some FATAL
21 | _ -> None
22
23let pp_severity ppf s =
24 Fmt.string ppf
25 (match s with
26 | DEBUG -> "DEBUG"
27 | INFO -> "INFO"
28 | WARNING -> "WARNING"
29 | ERROR -> "ERROR"
30 | FATAL -> "FATAL")
31
32type t = {
33 timestamp : int;
34 severity : int;
35 reserved : int;
36 event_code : int;
37 payload_len : int;
38 reserved2 : int;
39 payload : string;
40}
41
42let codec =
43 let open Codec in
44 record "EventLog"
45 (fun timestamp severity reserved event_code payload_len reserved2 payload ->
46 {
47 timestamp;
48 severity;
49 reserved;
50 event_code;
51 payload_len;
52 reserved2;
53 payload;
54 })
55 |+ field "timestamp" uint32be (fun t -> t.timestamp)
56 |+ field "severity" uint8 (fun t -> t.severity)
57 |+ field "reserved" uint8 (fun t -> t.reserved)
58 |+ field "event_code" uint16be (fun t -> t.event_code)
59 |+ field "payload_len" uint16be (fun t -> t.payload_len)
60 |+ field "reserved2" uint16be (fun t -> t.reserved2)
61 |+ field "payload"
62 (byte_array ~size:(int max_payload_len))
63 (fun t -> t.payload)
64 |> seal
65
66let pad_to n s =
67 let slen = String.length s in
68 if slen >= n then String.sub s 0 n
69 else
70 let b = Bytes.make n '\x00' in
71 Bytes.blit_string s 0 b 0 slen;
72 Bytes.unsafe_to_string b
73
74let v ~timestamp sev ~event_code payload =
75 let payload_len = min max_payload_len (String.length payload) in
76 {
77 timestamp;
78 severity = severity_to_int sev;
79 reserved = 0;
80 event_code;
81 payload_len;
82 reserved2 = 0;
83 payload = pad_to max_payload_len payload;
84 }
85
86let payload_bytes t =
87 String.sub t.payload 0 (min t.payload_len (String.length t.payload))
88
89let pp ppf t =
90 let sev =
91 match severity_of_int t.severity with
92 | Some s -> Fmt.str "%a" pp_severity s
93 | None -> Fmt.str "?%d" t.severity
94 in
95 Fmt.pf ppf "@[<h>event(t=%d %s code=%d payload=%S)@]" t.timestamp sev
96 t.event_code (payload_bytes t)
97
98let equal a b =
99 a.timestamp = b.timestamp && a.severity = b.severity
100 && a.event_code = b.event_code
101 && a.payload_len = b.payload_len
102 && String.equal a.payload b.payload