gazagnaire.org
SpaceOS wire protocol codecs for host-guest communication
feat(space-net): add APID virtual switch with per-module tests
Rename create → v, find_connection → connection, make_routable_frame →
routable_frame, make_socket_dir → socket_dir. Add pp to Config.t and
Switch.t. Split test_space_net.ml into test_config, test_connection,
test_router, test_switch with .mli interfaces and test.ml runner.
+2212
+524
bin/demo.ml
+524
bin/demo.ml
···
1
+
(** SpaceOS host-guest demo.
2
+
3
+
Single process, Unix socketpair. Host and guest run as Eio fibers sharing a
4
+
[Bytes.t] for simulated shared memory and a [Bytes.t] for simulated
5
+
virtio-blk storage.
6
+
7
+
Timeline:
8
+
- t=0: Guest boots, sends EVR, reads superblock, reads initial parameters
9
+
- t=1+: Guest sends TM at 1 Hz, heartbeat at 1 Hz
10
+
- t=2: Guest writes boot event to event log ring buffer
11
+
- t=3: Guest writes a data product to virtio-blk, sends DP notification
12
+
- t=4: Guest writes param to parameter store, logs event
13
+
- t=5: Host sends TC (CMD_DEPLOY)
14
+
- t=6: Guest sends a parameter response
15
+
- t=7: Guest sends a frame with invalid type (0xFF) to test ERROR/NACK
16
+
- t=8: Host sends PRM_SET to update a parameter
17
+
- t=9: Host reads event log from storage, guest updates param generation
18
+
- t=12: Host requests shutdown
19
+
- t=12+: Guest acks, sends final EVR, exits; host follows *)
20
+
21
+
open Spaceos_wire
22
+
23
+
(* CRC helper *)
24
+
let crc32c data =
25
+
Optint.to_unsigned_int
26
+
(Checkseum.Crc32c.digest_string data 0 (String.length data)
27
+
Checkseum.Crc32c.default)
28
+
29
+
let log_host fmt = Fmt.epr ("@[<h>[host] " ^^ fmt ^^ "@]@.")
30
+
let log_guest fmt = Fmt.epr ("@[<h>[guest] " ^^ fmt ^^ "@]@.")
31
+
32
+
(* Frame I/O *)
33
+
34
+
let read_frame reader =
35
+
let s = Eio.Buf_read.take Msg.frame_size reader in
36
+
Wire.Codec.decode Msg.codec (Bytes.of_string s) 0
37
+
38
+
let write_frame dst (frame : Msg.t) =
39
+
let buf = Bytes.make Msg.frame_size '\x00' in
40
+
Wire.Codec.encode Msg.codec frame buf 0;
41
+
Eio.Flow.copy_string (Bytes.unsafe_to_string buf) dst
42
+
43
+
(* Try to read a frame with timeout. Returns None on timeout. *)
44
+
let try_read_frame clock reader =
45
+
match Eio.Time.with_timeout clock 0.1 (fun () -> Ok (read_frame reader)) with
46
+
| Ok frame -> Some frame
47
+
| Error `Timeout -> None
48
+
49
+
(* Drain all available frames (non-blocking) *)
50
+
let drain_frames clock reader =
51
+
let frames = ref [] in
52
+
let continue = ref true in
53
+
while !continue do
54
+
match try_read_frame clock reader with
55
+
| Some frame -> frames := frame :: !frames
56
+
| None -> continue := false
57
+
done;
58
+
List.rev !frames
59
+
60
+
(* Encode an error payload into a frame *)
61
+
let error_frame code ~offending_type ~offending_apid ~offending_pay_len =
62
+
let err =
63
+
Error_payload.v code ~offending_type ~offending_apid ~offending_pay_len
64
+
in
65
+
let ws = Wire.Codec.wire_size Error_payload.codec in
66
+
let buf = Bytes.create ws in
67
+
Wire.Codec.encode Error_payload.codec err buf 0;
68
+
Msg.v ERROR ~apid:0 (Bytes.unsafe_to_string buf)
69
+
70
+
(* Encode a DP payload into a frame *)
71
+
let dp_frame ~block_offset ~block_count ~dp_class ~priority ~name ~crc32 =
72
+
let dp =
73
+
Dp_payload.v ~block_offset ~block_count ~dp_class ~priority ~name ~crc32
74
+
in
75
+
let ws = Wire.Codec.wire_size Dp_payload.codec in
76
+
let buf = Bytes.create ws in
77
+
Wire.Codec.encode Dp_payload.codec dp buf 0;
78
+
Msg.v DP ~apid:0x10 (Bytes.unsafe_to_string buf)
79
+
80
+
(* Storage simulation: block_size * num_blocks *)
81
+
let block_size = 4096
82
+
let total_blocks = 256
83
+
let param_store_start = 1 (* blocks 1-16 *)
84
+
let event_log_start = 17 (* blocks 17-32 *)
85
+
let dp_area_start = 33
86
+
87
+
(* Parameter store helpers *)
88
+
let param_entry_size = Wire.Codec.wire_size Param_entry.codec
89
+
90
+
let write_param storage ~slot (entry : Param_entry.t) =
91
+
let off = (param_store_start * block_size) + (slot * param_entry_size) in
92
+
let buf = Bytes.create param_entry_size in
93
+
Wire.Codec.encode Param_entry.codec entry buf 0;
94
+
Bytes.blit buf 0 storage off param_entry_size
95
+
96
+
let read_param storage ~slot =
97
+
let off = (param_store_start * block_size) + (slot * param_entry_size) in
98
+
let buf = Bytes.create param_entry_size in
99
+
Bytes.blit storage off buf 0 param_entry_size;
100
+
Wire.Codec.decode Param_entry.codec buf 0
101
+
102
+
(* Event log helpers: 8-byte write pointer at start of block 17,
103
+
then records follow *)
104
+
let event_record_size = Wire.Codec.wire_size Event_log.codec
105
+
let event_log_header_size = 8
106
+
107
+
let get_event_write_ptr storage =
108
+
let off = event_log_start * block_size in
109
+
Bytes.get_int64_be storage off |> Int64.to_int
110
+
111
+
let set_event_write_ptr storage ptr =
112
+
let off = event_log_start * block_size in
113
+
Bytes.set_int64_be storage off (Int64.of_int ptr)
114
+
115
+
let write_event storage (ev : Event_log.t) =
116
+
let ptr = get_event_write_ptr storage in
117
+
let base = (event_log_start * block_size) + event_log_header_size in
118
+
let area_size = (16 * block_size) - event_log_header_size in
119
+
let off = base + (ptr mod area_size) in
120
+
let buf = Bytes.create event_record_size in
121
+
Wire.Codec.encode Event_log.codec ev buf 0;
122
+
Bytes.blit buf 0 storage off event_record_size;
123
+
set_event_write_ptr storage (ptr + event_record_size)
124
+
125
+
let read_event storage ~index =
126
+
let base = (event_log_start * block_size) + event_log_header_size in
127
+
let off = base + (index * event_record_size) in
128
+
let buf = Bytes.create event_record_size in
129
+
Bytes.blit storage off buf 0 event_record_size;
130
+
Wire.Codec.decode Event_log.codec buf 0
131
+
132
+
(* Write superblock to storage *)
133
+
let init_storage storage =
134
+
let sb =
135
+
Superblock.v ~tenant_id:1 ~total_blocks ~dp_start:dp_area_start
136
+
~dp_size:(total_blocks - dp_area_start)
137
+
~epoch:1740000000L (* ~Feb 2025 TAI *)
138
+
~uuid:"demo-uuid-00001"
139
+
in
140
+
let ws = Wire.Codec.wire_size Superblock.codec in
141
+
let buf = Bytes.create ws in
142
+
Wire.Codec.encode Superblock.codec sb buf 0;
143
+
Bytes.blit buf 0 storage 0 ws;
144
+
sb
145
+
146
+
(* Read superblock from storage *)
147
+
let read_superblock storage =
148
+
let ws = Wire.Codec.wire_size Superblock.codec in
149
+
let buf = Bytes.create ws in
150
+
Bytes.blit storage 0 buf 0 ws;
151
+
Wire.Codec.decode Superblock.codec buf 0
152
+
153
+
(* Guest fiber *)
154
+
let run_guest ~clock ~shm ~storage src dst =
155
+
let reader = Eio.Buf_read.of_flow ~max_size:(Msg.frame_size * 100) src in
156
+
let heartbeat = ref 0L in
157
+
let running = ref true in
158
+
let seq = ref 0 in
159
+
160
+
(* Read and validate superblock *)
161
+
let sb = read_superblock storage in
162
+
if Superblock.check_magic sb && Superblock.check_crc sb then
163
+
log_guest "superblock OK: tenant=%d blocks=%d dp_start=%d uuid=%S"
164
+
sb.tenant_id sb.total_blocks sb.dp_start
165
+
(String.sub sb.uuid 0 (min 15 (String.length sb.uuid)))
166
+
else begin
167
+
log_guest "FATAL: superblock invalid";
168
+
running := false
169
+
end;
170
+
171
+
(* Read initial parameters from parameter store *)
172
+
let p0 = read_param storage ~slot:0 in
173
+
if Param_entry.check_crc p0 then
174
+
log_guest "param[0]: id=%d gen=%d value=%S" p0.param_id p0.generation
175
+
(Param_entry.value_bytes p0)
176
+
else log_guest "param[0]: no valid entry";
177
+
178
+
(* Send boot EVR *)
179
+
write_frame dst (Msg.v EVR ~apid:0x10 "guest booted successfully");
180
+
log_guest "sent boot EVR";
181
+
182
+
let tick = ref 0 in
183
+
while !running do
184
+
(* Heartbeat *)
185
+
heartbeat := Int64.add !heartbeat 1L;
186
+
Shared_mem.set_heartbeat shm !heartbeat;
187
+
Shared_mem.set_guest_status shm 0;
188
+
Shared_mem.set_health_string shm
189
+
(Fmt.str "nominal tick=%d seq=%d" !tick !seq);
190
+
191
+
(* Read mission time from shared memory *)
192
+
let mt = Shared_mem.read_mission_time shm in
193
+
if !tick mod 4 = 0 && Int64.compare mt.seconds 0L > 0 then
194
+
log_guest "mission time: %Ld.%09d" mt.seconds mt.nanos;
195
+
196
+
(* TM every tick *)
197
+
let payload =
198
+
Fmt.str "chan=TEMP val=%d.%d seq=%d"
199
+
(20 + (!tick mod 5))
200
+
(!tick * 37 mod 100)
201
+
!seq
202
+
in
203
+
write_frame dst (Msg.v TM ~apid:0x10 payload);
204
+
incr seq;
205
+
206
+
(* Event log at tick 2: write boot event to ring buffer *)
207
+
if !tick = 2 then begin
208
+
let ev =
209
+
Event_log.v
210
+
~timestamp:(Int64.to_int (Shared_mem.get_heartbeat shm))
211
+
INFO ~event_code:0x0001 "guest boot complete"
212
+
in
213
+
write_event storage ev;
214
+
log_guest "wrote event log: boot complete (code=0x0001)"
215
+
end;
216
+
217
+
(* DP at tick 3: write data product to storage, send notification *)
218
+
if !tick = 3 then begin
219
+
let dp_data = String.init block_size (fun i -> Char.chr (i land 0xFF)) in
220
+
let dp_offset = dp_area_start in
221
+
let storage_off = dp_offset * block_size in
222
+
Bytes.blit_string dp_data 0 storage storage_off block_size;
223
+
let crc = crc32c dp_data in
224
+
let frame =
225
+
dp_frame ~block_offset:0 ~block_count:1 ~dp_class:1 ~priority:2
226
+
~name:"science/thermal.dat" ~crc32:crc
227
+
in
228
+
write_frame dst frame;
229
+
log_guest "wrote DP: 1 block at offset %d, crc=0x%08x" dp_offset crc
230
+
end;
231
+
232
+
(* Param store at tick 4: write a parameter, log the event *)
233
+
if !tick = 4 then begin
234
+
let entry = Param_entry.v ~param_id:42 ~generation:1 "3.14159" in
235
+
write_param storage ~slot:1 entry;
236
+
log_guest "wrote param: id=42 gen=1 value=\"3.14159\"";
237
+
let ev =
238
+
Event_log.v
239
+
~timestamp:(Int64.to_int (Shared_mem.get_heartbeat shm))
240
+
INFO ~event_code:0x0010 "param 42 updated"
241
+
in
242
+
write_event storage ev;
243
+
log_guest "wrote event log: param updated (code=0x0010)"
244
+
end;
245
+
246
+
(* Param store at tick 9: update same parameter with higher generation *)
247
+
if !tick = 9 then begin
248
+
let entry = Param_entry.v ~param_id:42 ~generation:2 "2.71828" in
249
+
write_param storage ~slot:2 entry;
250
+
log_guest "wrote param: id=42 gen=2 value=\"2.71828\""
251
+
end;
252
+
253
+
(* PRM_RSP at tick 6: send a parameter response *)
254
+
if !tick = 6 then begin
255
+
let payload = Fmt.str "param_id=42 value=3.14159" in
256
+
write_frame dst (Msg.v PRM_RSP ~apid:0x01 payload);
257
+
log_guest "sent PRM_RSP for param 42"
258
+
end;
259
+
260
+
(* Intentionally send a bad frame at tick 7 to trigger ERROR *)
261
+
if !tick = 7 then begin
262
+
let bad_frame =
263
+
{
264
+
Msg.version = 0x01;
265
+
msg_type = 0xFF;
266
+
apid = 0x10;
267
+
payload_length = 0;
268
+
reserved = 0;
269
+
payload = String.make Msg.max_payload '\x00';
270
+
}
271
+
in
272
+
write_frame dst bad_frame;
273
+
log_guest "sent invalid type 0xFF (testing ERROR handling)"
274
+
end;
275
+
276
+
(* Process all incoming frames *)
277
+
let frames = drain_frames clock reader in
278
+
List.iter
279
+
(fun frame ->
280
+
match Msg.msg_type_of_int frame.Msg.msg_type with
281
+
| Some TC -> log_guest "received TC: %s" (Msg.payload_bytes frame)
282
+
| Some PRM_SET ->
283
+
log_guest "received PRM_SET: %s" (Msg.payload_bytes frame)
284
+
| Some ERROR ->
285
+
let payload = Msg.payload_bytes frame in
286
+
if String.length payload >= Wire.Codec.wire_size Error_payload.codec
287
+
then begin
288
+
let err =
289
+
Wire.Codec.decode Error_payload.codec (Bytes.of_string payload)
290
+
0
291
+
in
292
+
log_guest "received ERROR: %a" Error_payload.pp err
293
+
end
294
+
else log_guest "received ERROR (short payload)"
295
+
| Some _ -> log_guest "received %a" Msg.pp frame
296
+
| None -> log_guest "received unknown type 0x%02x" frame.Msg.msg_type)
297
+
frames;
298
+
299
+
(* Poll command word *)
300
+
let cmd = Shared_mem.get_host_cmd shm in
301
+
if cmd land Shared_mem.cmd_shutdown <> 0 then begin
302
+
log_guest "shutdown requested, performing graceful teardown";
303
+
(* Send final EVR *)
304
+
write_frame dst
305
+
(Msg.v EVR ~apid:0x10
306
+
(Fmt.str "shutting down after %d ticks, %d TM sent" !tick !seq));
307
+
Shared_mem.set_guest_cmd_ack shm Shared_mem.cmd_shutdown;
308
+
running := false
309
+
end;
310
+
311
+
if cmd land Shared_mem.cmd_dp_ack <> 0 then begin
312
+
log_guest "host acknowledged data product"
313
+
(* Clear the DP_ACK bit we noticed *)
314
+
end;
315
+
316
+
incr tick;
317
+
if !running then Eio.Time.sleep clock 1.0
318
+
done;
319
+
log_guest "exited cleanly"
320
+
321
+
(* Host fiber *)
322
+
let run_host ~clock ~shm ~storage src dst =
323
+
let reader = Eio.Buf_read.of_flow ~max_size:(Msg.frame_size * 100) src in
324
+
let last_heartbeat = ref 0L in
325
+
let missed = ref 0 in
326
+
let running = ref true in
327
+
let tick = ref 0 in
328
+
let tm_count = ref 0 in
329
+
let evr_count = ref 0 in
330
+
let dp_count = ref 0 in
331
+
332
+
while !running do
333
+
(* Update mission time at 1 Hz *)
334
+
let now = Eio.Time.now clock in
335
+
let seconds = Int64.of_float now in
336
+
let frac = now -. Int64.to_float seconds in
337
+
let nanos = int_of_float (frac *. 1e9) in
338
+
Shared_mem.write_mission_time shm Shared_mem.{ seconds; nanos };
339
+
340
+
(* Echo heartbeat *)
341
+
let hb = Shared_mem.get_heartbeat shm in
342
+
if Int64.equal hb !last_heartbeat then begin
343
+
incr missed;
344
+
if !missed >= 5 then begin
345
+
log_host "ALERT: heartbeat timeout (%d misses)" !missed;
346
+
Shared_mem.set_host_cmd shm Shared_mem.cmd_shutdown
347
+
end
348
+
end
349
+
else begin
350
+
if !missed > 0 then log_host "heartbeat recovered after %d misses" !missed;
351
+
missed := 0;
352
+
last_heartbeat := hb;
353
+
Shared_mem.set_heartbeat_ack shm hb
354
+
end;
355
+
356
+
(* Send TC at tick 5 *)
357
+
if !tick = 5 then begin
358
+
write_frame dst (Msg.v TC ~apid:0x10 "CMD_DEPLOY target=ANTENNA_1");
359
+
log_host "sent TC: CMD_DEPLOY target=ANTENNA_1"
360
+
end;
361
+
362
+
(* Send PRM_SET at tick 8 *)
363
+
if !tick = 8 then begin
364
+
write_frame dst (Msg.v PRM_SET ~apid:0x01 "param_id=42 value=2.71828");
365
+
log_host "sent PRM_SET: param 42 = 2.71828"
366
+
end;
367
+
368
+
(* Read event log + params at tick 9 *)
369
+
if !tick = 9 then begin
370
+
let ptr = get_event_write_ptr storage in
371
+
let n_events = ptr / event_record_size in
372
+
log_host "event log: %d events written" n_events;
373
+
for i = 0 to min (n_events - 1) 2 do
374
+
let ev = read_event storage ~index:i in
375
+
log_host " event[%d]: %a" i Event_log.pp ev
376
+
done;
377
+
(* Read latest param for id=42 *)
378
+
let p = read_param storage ~slot:2 in
379
+
if Param_entry.check_crc p then
380
+
log_host "param store: id=%d gen=%d value=%S" p.param_id p.generation
381
+
(Param_entry.value_bytes p)
382
+
else begin
383
+
let p1 = read_param storage ~slot:1 in
384
+
if Param_entry.check_crc p1 then
385
+
log_host "param store: id=%d gen=%d value=%S" p1.param_id
386
+
p1.generation
387
+
(Param_entry.value_bytes p1)
388
+
else log_host "param store: no valid entries for id=42"
389
+
end
390
+
end;
391
+
392
+
(* Shutdown at tick 12 *)
393
+
if !tick = 12 then begin
394
+
log_host "initiating shutdown sequence";
395
+
Shared_mem.set_host_cmd shm Shared_mem.cmd_shutdown
396
+
end;
397
+
398
+
(* Process all incoming frames *)
399
+
let frames = drain_frames clock reader in
400
+
List.iter
401
+
(fun frame ->
402
+
let (frame : Msg.t) = frame in
403
+
(* Validate version *)
404
+
if frame.version <> 0x01 then begin
405
+
log_host "ERROR: unknown version 0x%02x, sending NACK" frame.version;
406
+
write_frame dst
407
+
(error_frame Unknown_version ~offending_type:frame.Msg.msg_type
408
+
~offending_apid:frame.apid
409
+
~offending_pay_len:frame.payload_length)
410
+
end
411
+
else
412
+
match Msg.msg_type_of_int frame.Msg.msg_type with
413
+
| None ->
414
+
(* Unknown type → ERROR/NACK *)
415
+
log_host "ERROR: unknown type 0x%02x from apid %d, sending NACK"
416
+
frame.Msg.msg_type frame.apid;
417
+
write_frame dst
418
+
(error_frame Unknown_type ~offending_type:frame.Msg.msg_type
419
+
~offending_apid:frame.apid
420
+
~offending_pay_len:frame.payload_length)
421
+
| Some EVR ->
422
+
incr evr_count;
423
+
log_host "EVR[%d]: %s" !evr_count (Msg.payload_bytes frame)
424
+
| Some TM ->
425
+
incr tm_count;
426
+
if !tm_count <= 3 || !tm_count mod 5 = 0 then
427
+
log_host "TM[%d]: %s" !tm_count (Msg.payload_bytes frame)
428
+
| Some DP -> begin
429
+
incr dp_count;
430
+
let payload = Msg.payload_bytes frame in
431
+
if String.length payload >= Wire.Codec.wire_size Dp_payload.codec
432
+
then begin
433
+
let dp =
434
+
Wire.Codec.decode Dp_payload.codec (Bytes.of_string payload) 0
435
+
in
436
+
log_host "DP[%d]: %s offset=%d count=%d pri=%d crc=0x%08x"
437
+
!dp_count
438
+
(Dp_payload.name_string dp)
439
+
dp.block_offset dp.block_count dp.priority dp.crc32;
440
+
(* Validate CRC against storage *)
441
+
let storage_off =
442
+
(dp_area_start + dp.block_offset) * block_size
443
+
in
444
+
let data =
445
+
Bytes.sub_string storage storage_off
446
+
(dp.block_count * block_size)
447
+
in
448
+
let computed_crc = crc32c data in
449
+
if computed_crc = dp.crc32 then begin
450
+
log_host "DP CRC validated OK";
451
+
(* Set DP_ACK in command word *)
452
+
let cmd = Shared_mem.get_host_cmd shm in
453
+
Shared_mem.set_host_cmd shm (cmd lor Shared_mem.cmd_dp_ack)
454
+
end
455
+
else
456
+
log_host "DP CRC MISMATCH: expected 0x%08x, got 0x%08x"
457
+
dp.crc32 computed_crc
458
+
end
459
+
else
460
+
log_host "DP: short payload (%d bytes)" (String.length payload)
461
+
end
462
+
| Some PRM_RSP -> log_host "PRM_RSP: %s" (Msg.payload_bytes frame)
463
+
| Some HEALTH ->
464
+
let hs = Shared_mem.get_health_string shm in
465
+
log_host "HEALTH ping (health=%S)" hs
466
+
| Some msg_type ->
467
+
log_host "received %a: %s" Msg.pp_msg_type msg_type
468
+
(Msg.payload_bytes frame))
469
+
frames;
470
+
471
+
(* Check guest ack for shutdown *)
472
+
let ack = Shared_mem.get_guest_cmd_ack shm in
473
+
if ack land Shared_mem.cmd_shutdown <> 0 then begin
474
+
log_host "guest acknowledged shutdown";
475
+
let n_events = get_event_write_ptr storage / event_record_size in
476
+
log_host "session summary: %d TM, %d EVR, %d DP, %d events logged"
477
+
!tm_count !evr_count !dp_count n_events;
478
+
running := false
479
+
end;
480
+
481
+
incr tick;
482
+
if !running then Eio.Time.sleep clock 1.0
483
+
done;
484
+
log_host "exited"
485
+
486
+
let () =
487
+
Eio_main.run @@ fun env ->
488
+
let clock = Eio.Stdenv.clock env in
489
+
490
+
(* Shared memory page *)
491
+
let shm = Bytes.make Shared_mem.page_size '\x00' in
492
+
493
+
(* Simulated virtio-blk storage *)
494
+
let storage = Bytes.make (total_blocks * block_size) '\x00' in
495
+
496
+
(* Host initializes storage with superblock *)
497
+
let sb = init_storage storage in
498
+
499
+
(* Host writes initial parameter (slot 0) *)
500
+
let p0 = Param_entry.v ~param_id:1 ~generation:0 "boot_count=7" in
501
+
write_param storage ~slot:0 p0;
502
+
503
+
(* Initialize event log write pointer to 0 *)
504
+
set_event_write_ptr storage 0;
505
+
506
+
Fmt.epr "@.=== SpaceOS Demo ===@.";
507
+
Fmt.epr "Superblock: magic=0x%08x tenant=%d blocks=%d dp=%d+%d@." sb.magic
508
+
sb.tenant_id sb.total_blocks sb.dp_start sb.dp_size;
509
+
Fmt.epr "Param store: slot 0 = id=%d gen=%d value=%S@." p0.param_id
510
+
p0.generation
511
+
(Param_entry.value_bytes p0);
512
+
Fmt.epr "@.";
513
+
514
+
Eio.Switch.run @@ fun sw ->
515
+
let s1, s2 = Eio_unix.Net.socketpair_stream ~sw () in
516
+
Eio.Fiber.both
517
+
(fun () ->
518
+
run_guest ~clock ~shm ~storage
519
+
(s1 :> _ Eio.Flow.source)
520
+
(s1 :> _ Eio.Flow.sink))
521
+
(fun () ->
522
+
run_host ~clock ~shm ~storage
523
+
(s2 :> _ Eio.Flow.source)
524
+
(s2 :> _ Eio.Flow.sink))
+5
bin/dune
+5
bin/dune
+22
dune-project
+22
dune-project
···
1
+
(lang dune 3.21)
2
+
(using directory-targets 0.1)
3
+
4
+
(name spaceos-wire)
5
+
6
+
(generate_opam_files true)
7
+
8
+
(license MIT)
9
+
(authors "Thomas Gazagnaire")
10
+
(maintainers "Thomas Gazagnaire")
11
+
12
+
(package
13
+
(name spaceos-wire)
14
+
(synopsis "SpaceOS wire protocol codecs")
15
+
(description
16
+
"Wire codecs for the SpaceOS host-guest communication protocol. Fixed-size frames, shared memory layout, and storage block codecs for F Prime integration.")
17
+
(depends
18
+
(ocaml (>= 5.1))
19
+
wire
20
+
checkseum
21
+
(alcotest :with-test)
22
+
(crowbar :with-test)))
+22
fuzz/dune
+22
fuzz/dune
···
1
+
(executable
2
+
(name fuzz_spaceos_wire)
3
+
(modules fuzz_spaceos_wire)
4
+
(libraries spaceos_wire wire crowbar))
5
+
6
+
; Quick check with Crowbar (no AFL instrumentation)
7
+
8
+
(rule
9
+
(alias fuzz)
10
+
(deps fuzz_spaceos_wire.exe)
11
+
(action
12
+
(run %{exe:fuzz_spaceos_wire.exe})))
13
+
14
+
; AFL-instrumented build target (use with --profile=afl)
15
+
16
+
(rule
17
+
(alias fuzz-afl)
18
+
(deps
19
+
(source_tree input)
20
+
fuzz_spaceos_wire.exe)
21
+
(action
22
+
(echo "AFL fuzzer built: %{exe:fuzz_spaceos_wire.exe}\n")))
+141
fuzz/fuzz_spaceos_wire.ml
+141
fuzz/fuzz_spaceos_wire.ml
···
1
+
(** Fuzz tests for spaceos-wire codecs.
2
+
3
+
Tests roundtrip invariant (encode -> decode -> encode = encode) and crash
4
+
safety of decode on arbitrary input for all codecs. *)
5
+
6
+
module Cr = Crowbar
7
+
open Spaceos_wire
8
+
9
+
(* Helpers *)
10
+
11
+
let encode codec v =
12
+
let ws = Wire.Codec.wire_size codec in
13
+
let buf = Bytes.create ws in
14
+
Wire.Codec.encode codec v buf 0;
15
+
Bytes.unsafe_to_string buf
16
+
17
+
let decode codec s =
18
+
let ws = Wire.Codec.wire_size codec in
19
+
if String.length s < ws then None
20
+
else Some (Wire.Codec.decode codec (Bytes.of_string s) 0)
21
+
22
+
let pad_to n buf =
23
+
let len = String.length buf in
24
+
if len >= n then String.sub buf 0 n
25
+
else
26
+
let b = Bytes.make n '\x00' in
27
+
Bytes.blit_string buf 0 b 0 len;
28
+
Bytes.to_string b
29
+
30
+
(* === Frame fuzz === *)
31
+
32
+
let () =
33
+
(* Roundtrip: encode -> decode -> encode = encode *)
34
+
Cr.add_test ~name:"frame: roundtrip" [ Cr.bytes ] (fun buf ->
35
+
let buf = pad_to Msg.frame_size buf in
36
+
match decode Msg.codec buf with
37
+
| None -> ()
38
+
| Some v ->
39
+
let encoded1 = encode Msg.codec v in
40
+
let v2 = Wire.Codec.decode Msg.codec (Bytes.of_string encoded1) 0 in
41
+
let encoded2 = encode Msg.codec v2 in
42
+
if encoded1 <> encoded2 then
43
+
Cr.fail "frame roundtrip: second encode differs");
44
+
45
+
(* Decode doesn't crash on arbitrary input *)
46
+
Cr.add_test ~name:"frame: decode crash safety" [ Cr.bytes ] (fun buf ->
47
+
let buf = pad_to Msg.frame_size buf in
48
+
let _ = decode Msg.codec buf in
49
+
())
50
+
51
+
(* === Error payload fuzz === *)
52
+
53
+
let () =
54
+
Cr.add_test ~name:"error: roundtrip" [ Cr.bytes ] (fun buf ->
55
+
let buf = pad_to (Wire.Codec.wire_size Error_payload.codec) buf in
56
+
match decode Error_payload.codec buf with
57
+
| None -> ()
58
+
| Some v ->
59
+
let e1 = encode Error_payload.codec v in
60
+
let v2 =
61
+
Wire.Codec.decode Error_payload.codec (Bytes.of_string e1) 0
62
+
in
63
+
let e2 = encode Error_payload.codec v2 in
64
+
if e1 <> e2 then Cr.fail "error roundtrip: second encode differs");
65
+
66
+
Cr.add_test ~name:"error: decode crash safety" [ Cr.bytes ] (fun buf ->
67
+
let buf = pad_to (Wire.Codec.wire_size Error_payload.codec) buf in
68
+
let _ = decode Error_payload.codec buf in
69
+
())
70
+
71
+
(* === DP payload fuzz === *)
72
+
73
+
let () =
74
+
Cr.add_test ~name:"dp: roundtrip" [ Cr.bytes ] (fun buf ->
75
+
let buf = pad_to (Wire.Codec.wire_size Dp_payload.codec) buf in
76
+
match decode Dp_payload.codec buf with
77
+
| None -> ()
78
+
| Some v ->
79
+
let e1 = encode Dp_payload.codec v in
80
+
let v2 = Wire.Codec.decode Dp_payload.codec (Bytes.of_string e1) 0 in
81
+
let e2 = encode Dp_payload.codec v2 in
82
+
if e1 <> e2 then Cr.fail "dp roundtrip: second encode differs");
83
+
84
+
Cr.add_test ~name:"dp: decode crash safety" [ Cr.bytes ] (fun buf ->
85
+
let buf = pad_to (Wire.Codec.wire_size Dp_payload.codec) buf in
86
+
let _ = decode Dp_payload.codec buf in
87
+
())
88
+
89
+
(* === Superblock fuzz === *)
90
+
91
+
let () =
92
+
Cr.add_test ~name:"superblock: roundtrip" [ Cr.bytes ] (fun buf ->
93
+
let buf = pad_to (Wire.Codec.wire_size Superblock.codec) buf in
94
+
match decode Superblock.codec buf with
95
+
| None -> ()
96
+
| Some v ->
97
+
let e1 = encode Superblock.codec v in
98
+
let v2 = Wire.Codec.decode Superblock.codec (Bytes.of_string e1) 0 in
99
+
let e2 = encode Superblock.codec v2 in
100
+
if e1 <> e2 then Cr.fail "superblock roundtrip: second encode differs");
101
+
102
+
Cr.add_test ~name:"superblock: decode crash safety" [ Cr.bytes ] (fun buf ->
103
+
let buf = pad_to (Wire.Codec.wire_size Superblock.codec) buf in
104
+
let _ = decode Superblock.codec buf in
105
+
())
106
+
107
+
(* === Param entry fuzz === *)
108
+
109
+
let () =
110
+
Cr.add_test ~name:"param: roundtrip" [ Cr.bytes ] (fun buf ->
111
+
let buf = pad_to (Wire.Codec.wire_size Param_entry.codec) buf in
112
+
match decode Param_entry.codec buf with
113
+
| None -> ()
114
+
| Some v ->
115
+
let e1 = encode Param_entry.codec v in
116
+
let v2 = Wire.Codec.decode Param_entry.codec (Bytes.of_string e1) 0 in
117
+
let e2 = encode Param_entry.codec v2 in
118
+
if e1 <> e2 then Cr.fail "param roundtrip: second encode differs");
119
+
120
+
Cr.add_test ~name:"param: decode crash safety" [ Cr.bytes ] (fun buf ->
121
+
let buf = pad_to (Wire.Codec.wire_size Param_entry.codec) buf in
122
+
let _ = decode Param_entry.codec buf in
123
+
())
124
+
125
+
(* === Event log fuzz === *)
126
+
127
+
let () =
128
+
Cr.add_test ~name:"event: roundtrip" [ Cr.bytes ] (fun buf ->
129
+
let buf = pad_to (Wire.Codec.wire_size Event_log.codec) buf in
130
+
match decode Event_log.codec buf with
131
+
| None -> ()
132
+
| Some v ->
133
+
let e1 = encode Event_log.codec v in
134
+
let v2 = Wire.Codec.decode Event_log.codec (Bytes.of_string e1) 0 in
135
+
let e2 = encode Event_log.codec v2 in
136
+
if e1 <> e2 then Cr.fail "event roundtrip: second encode differs");
137
+
138
+
Cr.add_test ~name:"event: decode crash safety" [ Cr.bytes ] (fun buf ->
139
+
let buf = pad_to (Wire.Codec.wire_size Event_log.codec) buf in
140
+
let _ = decode Event_log.codec buf in
141
+
())
+41
lib/dp_payload.ml
+41
lib/dp_payload.ml
···
1
+
open Wire
2
+
3
+
type 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
+
13
+
let 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
+
27
+
let 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
+
31
+
let name_string t = String.sub t.name 0 (min t.name_len (String.length t.name))
32
+
33
+
let 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
+
37
+
let 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
+36
lib/dp_payload.mli
+36
lib/dp_payload.mli
···
1
+
(** Data Product notification payload codec (80 bytes fixed).
2
+
3
+
{v
4
+
0x00 uint32 block_offset
5
+
0x04 uint32 block_count
6
+
0x08 uint16 dp_class
7
+
0x0A uint8 priority
8
+
0x0B uint8 name_len
9
+
0x0C bytes name (64 bytes, null-padded)
10
+
0x4C uint32 crc32
11
+
v} *)
12
+
13
+
type t = {
14
+
block_offset : int;
15
+
block_count : int;
16
+
dp_class : int;
17
+
priority : int;
18
+
name_len : int;
19
+
name : string;
20
+
crc32 : int;
21
+
}
22
+
23
+
val codec : t Wire.Codec.t
24
+
25
+
val v :
26
+
block_offset:int ->
27
+
block_count:int ->
28
+
dp_class:int ->
29
+
priority:int ->
30
+
name:string ->
31
+
crc32:int ->
32
+
t
33
+
34
+
val name_string : t -> string
35
+
val pp : t Fmt.t
36
+
val equal : t -> t -> bool
+4
lib/dune
+4
lib/dune
+71
lib/error_payload.ml
+71
lib/error_payload.ml
···
1
+
open Wire
2
+
3
+
type error_code =
4
+
| Unknown_type
5
+
| Unknown_version
6
+
| Message_too_large
7
+
| Apid_not_allocated
8
+
| Host_busy
9
+
| Malformed
10
+
11
+
let error_code_to_int = function
12
+
| Unknown_type -> 0x01
13
+
| Unknown_version -> 0x02
14
+
| Message_too_large -> 0x03
15
+
| Apid_not_allocated -> 0x04
16
+
| Host_busy -> 0x05
17
+
| Malformed -> 0x06
18
+
19
+
let error_code_of_int = function
20
+
| 0x01 -> Some Unknown_type
21
+
| 0x02 -> Some Unknown_version
22
+
| 0x03 -> Some Message_too_large
23
+
| 0x04 -> Some Apid_not_allocated
24
+
| 0x05 -> Some Host_busy
25
+
| 0x06 -> Some Malformed
26
+
| _ -> None
27
+
28
+
type t = {
29
+
error_code : int;
30
+
offending_type : int;
31
+
offending_apid : int;
32
+
offending_pay_len : int;
33
+
reserved : int;
34
+
}
35
+
36
+
let codec =
37
+
let open Codec in
38
+
record "ErrorPayload"
39
+
(fun error_code offending_type offending_apid offending_pay_len reserved ->
40
+
{
41
+
error_code;
42
+
offending_type;
43
+
offending_apid;
44
+
offending_pay_len;
45
+
reserved;
46
+
})
47
+
|+ field "error_code" uint8 (fun t -> t.error_code)
48
+
|+ field "offending_type" uint8 (fun t -> t.offending_type)
49
+
|+ field "offending_apid" uint16be (fun t -> t.offending_apid)
50
+
|+ field "offending_pay_len" uint16be (fun t -> t.offending_pay_len)
51
+
|+ field "reserved" uint16be (fun t -> t.reserved)
52
+
|> seal
53
+
54
+
let v code ~offending_type ~offending_apid ~offending_pay_len =
55
+
{
56
+
error_code = error_code_to_int code;
57
+
offending_type;
58
+
offending_apid;
59
+
offending_pay_len;
60
+
reserved = 0;
61
+
}
62
+
63
+
let pp ppf t =
64
+
Fmt.pf ppf "@[<h>error(code=0x%02x type=0x%02x apid=%d pay_len=%d)@]"
65
+
t.error_code t.offending_type t.offending_apid t.offending_pay_len
66
+
67
+
let equal a b =
68
+
a.error_code = b.error_code
69
+
&& a.offending_type = b.offending_type
70
+
&& a.offending_apid = b.offending_apid
71
+
&& a.offending_pay_len = b.offending_pay_len
+40
lib/error_payload.mli
+40
lib/error_payload.mli
···
1
+
(** ERROR/NACK payload codec (8 bytes).
2
+
3
+
{v
4
+
0x00 uint8 error_code
5
+
0x01 uint8 offending_type
6
+
0x02 uint16 offending_apid
7
+
0x04 uint16 offending_pay_len
8
+
0x06 uint16 reserved
9
+
v} *)
10
+
11
+
type error_code =
12
+
| Unknown_type
13
+
| Unknown_version
14
+
| Message_too_large
15
+
| Apid_not_allocated
16
+
| Host_busy
17
+
| Malformed
18
+
19
+
val error_code_to_int : error_code -> int
20
+
val error_code_of_int : int -> error_code option
21
+
22
+
type t = {
23
+
error_code : int;
24
+
offending_type : int;
25
+
offending_apid : int;
26
+
offending_pay_len : int;
27
+
reserved : int;
28
+
}
29
+
30
+
val codec : t Wire.Codec.t
31
+
32
+
val v :
33
+
error_code ->
34
+
offending_type:int ->
35
+
offending_apid:int ->
36
+
offending_pay_len:int ->
37
+
t
38
+
39
+
val pp : t Fmt.t
40
+
val equal : t -> t -> bool
+102
lib/event_log.ml
+102
lib/event_log.ml
···
1
+
open Wire
2
+
3
+
let max_payload_len = 64
4
+
let record_size = 76
5
+
6
+
type severity = DEBUG | INFO | WARNING | ERROR | FATAL
7
+
8
+
let severity_to_int = function
9
+
| DEBUG -> 0
10
+
| INFO -> 1
11
+
| WARNING -> 2
12
+
| ERROR -> 3
13
+
| FATAL -> 4
14
+
15
+
let 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
+
23
+
let 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
+
32
+
type 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
+
42
+
let 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
+
66
+
let 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
+
74
+
let 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
+
86
+
let payload_bytes t =
87
+
String.sub t.payload 0 (min t.payload_len (String.length t.payload))
88
+
89
+
let 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
+
98
+
let 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
+54
lib/event_log.mli
+54
lib/event_log.mli
···
1
+
(** Event Log record codec (ring buffer, blocks 17-32).
2
+
3
+
{v
4
+
0x00 uint32 timestamp (seconds since epoch)
5
+
0x04 uint8 severity
6
+
0x05 uint8 reserved
7
+
0x06 uint16 event_code
8
+
0x08 uint16 payload_len
9
+
0x0A uint16 reserved2
10
+
0x0C bytes payload (64 bytes, zero-padded)
11
+
v}
12
+
13
+
The event log is a ring buffer. A write pointer (8 bytes) is stored at the
14
+
start of block 17. Records follow contiguously after the write pointer. *)
15
+
16
+
(** {1 Constants} *)
17
+
18
+
val max_payload_len : int
19
+
(** Maximum event payload: 64 bytes. *)
20
+
21
+
val record_size : int
22
+
(** Fixed record size: 76 bytes. *)
23
+
24
+
(** {1 Severity} *)
25
+
26
+
type severity = DEBUG | INFO | WARNING | ERROR | FATAL
27
+
28
+
val severity_to_int : severity -> int
29
+
val severity_of_int : int -> severity option
30
+
val pp_severity : severity Fmt.t
31
+
32
+
(** {1 Type} *)
33
+
34
+
type t = {
35
+
timestamp : int;
36
+
severity : int;
37
+
reserved : int;
38
+
event_code : int;
39
+
payload_len : int;
40
+
reserved2 : int;
41
+
payload : string;
42
+
}
43
+
44
+
val codec : t Wire.Codec.t
45
+
46
+
val v : timestamp:int -> severity -> event_code:int -> string -> t
47
+
(** [v ~timestamp sev ~event_code payload] builds an event log record. *)
48
+
49
+
val payload_bytes : t -> string
50
+
(** [payload_bytes t] returns the meaningful payload (first [payload_len]
51
+
bytes). *)
52
+
53
+
val pp : t Fmt.t
54
+
val equal : t -> t -> bool
+109
lib/msg.ml
+109
lib/msg.ml
···
1
+
open Wire
2
+
3
+
let frame_size = 256
4
+
let header_size = 8
5
+
let max_payload = frame_size - header_size
6
+
7
+
type msg_type =
8
+
| TM
9
+
| TC
10
+
| EVR
11
+
| PRM_GET
12
+
| PRM_SET
13
+
| PRM_RSP
14
+
| DP
15
+
| HEALTH
16
+
| LOG
17
+
| ERROR
18
+
19
+
let msg_type_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
+
31
+
let msg_type_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
+
44
+
let pp_msg_type 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
+
56
+
type t = {
57
+
version : int;
58
+
msg_type : int;
59
+
apid : int;
60
+
payload_length : int;
61
+
reserved : int;
62
+
payload : string;
63
+
}
64
+
65
+
let 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
+
78
+
let 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 = msg_type_to_int typ;
86
+
apid;
87
+
payload_length;
88
+
reserved = 0;
89
+
payload = Bytes.unsafe_to_string padded;
90
+
}
91
+
92
+
let payload_bytes t =
93
+
let n = max 0 (min max_payload t.payload_length) in
94
+
String.sub t.payload 0 n
95
+
96
+
let pp ppf t =
97
+
let typ_s =
98
+
match msg_type_of_int t.msg_type with
99
+
| Some mt -> Fmt.str "%a" pp_msg_type 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
+
105
+
let 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
+65
lib/msg.mli
+65
lib/msg.mli
···
1
+
(** SpaceOS fixed-size frame codec.
2
+
3
+
Every read/write is exactly 256 bytes. The [payload_length] field tells how
4
+
many of the 248 payload bytes are meaningful.
5
+
6
+
{v
7
+
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
8
+
| Version | Type | APID (uint16 BE) |
9
+
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
10
+
| Payload Length (uint16) | Reserved (uint16) |
11
+
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
12
+
| Payload (248 bytes, zero-padded) |
13
+
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
14
+
v} *)
15
+
16
+
val frame_size : int
17
+
(** Fixed frame size: 256 bytes. *)
18
+
19
+
val header_size : int
20
+
(** Header size: 8 bytes. *)
21
+
22
+
val max_payload : int
23
+
(** Maximum payload: 248 bytes. *)
24
+
25
+
(** {1 Message types} *)
26
+
27
+
type msg_type =
28
+
| TM
29
+
| TC
30
+
| EVR
31
+
| PRM_GET
32
+
| PRM_SET
33
+
| PRM_RSP
34
+
| DP
35
+
| HEALTH
36
+
| LOG
37
+
| ERROR
38
+
39
+
val msg_type_to_int : msg_type -> int
40
+
val msg_type_of_int : int -> msg_type option
41
+
val pp_msg_type : msg_type Fmt.t
42
+
43
+
(** {1 Frame} *)
44
+
45
+
type t = {
46
+
version : int;
47
+
msg_type : int;
48
+
apid : int;
49
+
payload_length : int;
50
+
reserved : int;
51
+
payload : string;
52
+
}
53
+
54
+
val codec : t Wire.Codec.t
55
+
(** Wire codec for the full 256-byte frame. *)
56
+
57
+
val v : msg_type -> apid:int -> string -> t
58
+
(** [v typ ~apid payload] builds a frame. Payload is truncated to 248 bytes. *)
59
+
60
+
val payload_bytes : t -> string
61
+
(** [payload_bytes t] returns the meaningful payload bytes (first
62
+
[payload_length] bytes). *)
63
+
64
+
val pp : t Fmt.t
65
+
val equal : t -> t -> bool
+64
lib/param_entry.ml
+64
lib/param_entry.ml
···
1
+
open Wire
2
+
3
+
let max_value_len = 240
4
+
5
+
type t = {
6
+
param_id : int;
7
+
len : int;
8
+
generation : int;
9
+
value : string;
10
+
crc32 : int;
11
+
}
12
+
13
+
let codec =
14
+
let open Codec in
15
+
record "ParamEntry" (fun param_id len generation value crc32 ->
16
+
{ param_id; len; generation; value; crc32 })
17
+
|+ field "param_id" uint32be (fun t -> t.param_id)
18
+
|+ field "len" uint16be (fun t -> t.len)
19
+
|+ field "generation" uint16be (fun t -> t.generation)
20
+
|+ field "value" (byte_array ~size:(int max_value_len)) (fun t -> t.value)
21
+
|+ field "crc32" uint32be (fun t -> t.crc32)
22
+
|> seal
23
+
24
+
let crc32c data =
25
+
Optint.to_unsigned_int
26
+
(Checkseum.Crc32c.digest_string data 0 (String.length data)
27
+
Checkseum.Crc32c.default)
28
+
29
+
let compute_crc t =
30
+
let wire_size = Codec.wire_size codec in
31
+
let buf = Bytes.create wire_size in
32
+
Codec.encode codec t buf 0;
33
+
(* CRC covers everything before the CRC field *)
34
+
crc32c (Bytes.sub_string buf 0 (wire_size - 4))
35
+
36
+
let pad_to n s =
37
+
let slen = String.length s in
38
+
if slen >= n then String.sub s 0 n
39
+
else
40
+
let b = Bytes.make n '\x00' in
41
+
Bytes.blit_string s 0 b 0 slen;
42
+
Bytes.unsafe_to_string b
43
+
44
+
let v ~param_id ~generation value =
45
+
let len = min max_value_len (String.length value) in
46
+
let value = pad_to max_value_len value in
47
+
let t = { param_id; len; generation; value; crc32 = 0 } in
48
+
{ t with crc32 = compute_crc t }
49
+
50
+
let value_bytes t = String.sub t.value 0 (min t.len (String.length t.value))
51
+
52
+
let check_crc t =
53
+
let expected = compute_crc { t with crc32 = 0 } in
54
+
t.crc32 = expected
55
+
56
+
let pp ppf t =
57
+
Fmt.pf ppf "@[<h>param(id=%d gen=%d len=%d crc=0x%08x)@]" t.param_id
58
+
t.generation t.len t.crc32
59
+
60
+
let equal a b =
61
+
a.param_id = b.param_id && a.len = b.len
62
+
&& a.generation = b.generation
63
+
&& String.equal a.value b.value
64
+
&& a.crc32 = b.crc32
+45
lib/param_entry.mli
+45
lib/param_entry.mli
···
1
+
(** Parameter Store entry codec.
2
+
3
+
{v
4
+
0x00 uint32 param_id
5
+
0x04 uint16 len
6
+
0x06 uint16 generation
7
+
0x08 bytes value (len bytes, padded to 4-byte alignment)
8
+
0x?? uint32 crc32 (CRC-32C of param_id through value)
9
+
v}
10
+
11
+
The parameter store occupies blocks 1-16 of the virtio-blk device. Entries
12
+
are appended sequentially. The guest reads the highest-generation entry for
13
+
each param_id. *)
14
+
15
+
(** {1 Constants} *)
16
+
17
+
val max_value_len : int
18
+
(** Maximum value length: 240 bytes (248 - 8 header bytes). *)
19
+
20
+
(** {1 Type} *)
21
+
22
+
type t = {
23
+
param_id : int;
24
+
len : int;
25
+
generation : int;
26
+
value : string;
27
+
crc32 : int;
28
+
}
29
+
30
+
val codec : t Wire.Codec.t
31
+
(** Wire codec for a parameter entry. The value is stored as a fixed 240-byte
32
+
field (zero-padded). Total size: 252 bytes. *)
33
+
34
+
val v : param_id:int -> generation:int -> string -> t
35
+
(** [v ~param_id ~generation value] builds a parameter entry with computed CRC.
36
+
Value is truncated to {!max_value_len}. *)
37
+
38
+
val value_bytes : t -> string
39
+
(** [value_bytes t] returns the meaningful value (first [len] bytes). *)
40
+
41
+
val check_crc : t -> bool
42
+
(** [check_crc t] validates the CRC-32C. *)
43
+
44
+
val pp : t Fmt.t
45
+
val equal : t -> t -> bool
+110
lib/superblock.ml
+110
lib/superblock.ml
···
1
+
open Wire
2
+
3
+
let magic = 0x53504F53
4
+
5
+
type t = {
6
+
magic : int;
7
+
format_version : int;
8
+
reserved : int;
9
+
tenant_id : int;
10
+
total_blocks : int;
11
+
dp_start : int;
12
+
dp_size : int;
13
+
epoch : int64;
14
+
uuid : string;
15
+
crc32 : int;
16
+
}
17
+
18
+
let codec =
19
+
let open Codec in
20
+
record "Superblock"
21
+
(fun
22
+
magic
23
+
format_version
24
+
reserved
25
+
tenant_id
26
+
total_blocks
27
+
dp_start
28
+
dp_size
29
+
epoch
30
+
uuid
31
+
crc32
32
+
->
33
+
{
34
+
magic;
35
+
format_version;
36
+
reserved;
37
+
tenant_id;
38
+
total_blocks;
39
+
dp_start;
40
+
dp_size;
41
+
epoch;
42
+
uuid;
43
+
crc32;
44
+
})
45
+
|+ field "magic" uint32be (fun t -> t.magic)
46
+
|+ field "format_version" uint8 (fun t -> t.format_version)
47
+
|+ field "reserved" uint8 (fun t -> t.reserved)
48
+
|+ field "tenant_id" uint16be (fun t -> t.tenant_id)
49
+
|+ field "total_blocks" uint32be (fun t -> t.total_blocks)
50
+
|+ field "dp_start" uint32be (fun t -> t.dp_start)
51
+
|+ field "dp_size" uint32be (fun t -> t.dp_size)
52
+
|+ field "epoch" uint64be (fun t -> t.epoch)
53
+
|+ field "uuid" (byte_array ~size:(int 16)) (fun t -> t.uuid)
54
+
|+ field "crc32" uint32be (fun t -> t.crc32)
55
+
|> seal
56
+
57
+
let crc32c data =
58
+
let v =
59
+
Checkseum.Crc32c.digest_string data 0 (String.length data)
60
+
Checkseum.Crc32c.default
61
+
in
62
+
Optint.to_unsigned_int v
63
+
64
+
let compute_crc t =
65
+
(* CRC covers bytes 0-47 (everything before the CRC field) *)
66
+
let wire_size = Codec.wire_size codec in
67
+
let buf = Bytes.create wire_size in
68
+
Codec.encode codec t buf 0;
69
+
(* CRC covers first 48 bytes (wire_size - 4) *)
70
+
let crc_len = wire_size - 4 in
71
+
crc32c (Bytes.sub_string buf 0 crc_len)
72
+
73
+
let v ~tenant_id ~total_blocks ~dp_start ~dp_size ~epoch ~uuid =
74
+
let t =
75
+
{
76
+
magic;
77
+
format_version = 0x01;
78
+
reserved = 0;
79
+
tenant_id;
80
+
total_blocks;
81
+
dp_start;
82
+
dp_size;
83
+
epoch;
84
+
uuid;
85
+
crc32 = 0;
86
+
}
87
+
in
88
+
{ t with crc32 = compute_crc t }
89
+
90
+
let check_magic t = t.magic = magic
91
+
92
+
let check_crc t =
93
+
let expected = compute_crc { t with crc32 = 0 } in
94
+
t.crc32 = expected
95
+
96
+
let pp ppf t =
97
+
Fmt.pf ppf
98
+
"@[<h>superblock(magic=0x%08x ver=%d tenant=%d blocks=%d dp=%d+%d \
99
+
crc=0x%08x)@]"
100
+
t.magic t.format_version t.tenant_id t.total_blocks t.dp_start t.dp_size
101
+
t.crc32
102
+
103
+
let equal a b =
104
+
a.magic = b.magic
105
+
&& a.format_version = b.format_version
106
+
&& a.tenant_id = b.tenant_id
107
+
&& a.total_blocks = b.total_blocks
108
+
&& a.dp_start = b.dp_start && a.dp_size = b.dp_size
109
+
&& Int64.equal a.epoch b.epoch
110
+
&& String.equal a.uuid b.uuid && a.crc32 = b.crc32
+47
lib/superblock.mli
+47
lib/superblock.mli
···
1
+
(** Superblock codec (block 0, 48 bytes).
2
+
3
+
{v
4
+
0x00 uint32 magic (0x53504F53 = "SPOS")
5
+
0x04 uint8 format_version
6
+
0x05 uint8 reserved
7
+
0x06 uint16 tenant_id
8
+
0x08 uint32 total_blocks
9
+
0x0C uint32 dp_start
10
+
0x10 uint32 dp_size
11
+
0x14 uint64 epoch
12
+
0x1C bytes uuid (16 bytes)
13
+
0x2C uint32 crc32
14
+
v} *)
15
+
16
+
val magic : int
17
+
(** [0x53504F53] = "SPOS". *)
18
+
19
+
type t = {
20
+
magic : int;
21
+
format_version : int;
22
+
reserved : int;
23
+
tenant_id : int;
24
+
total_blocks : int;
25
+
dp_start : int;
26
+
dp_size : int;
27
+
epoch : int64;
28
+
uuid : string;
29
+
crc32 : int;
30
+
}
31
+
32
+
val codec : t Wire.Codec.t
33
+
34
+
val v :
35
+
tenant_id:int ->
36
+
total_blocks:int ->
37
+
dp_start:int ->
38
+
dp_size:int ->
39
+
epoch:int64 ->
40
+
uuid:string ->
41
+
t
42
+
(** Build a superblock with computed CRC. *)
43
+
44
+
val check_magic : t -> bool
45
+
val check_crc : t -> bool
46
+
val pp : t Fmt.t
47
+
val equal : t -> t -> bool
+4
lib/wire/dune
+4
lib/wire/dune
+77
lib/wire/spaceos_wire_3d.ml
+77
lib/wire/spaceos_wire_3d.ml
···
1
+
(** SpaceOS Wire schemas for EverParse 3D generation.
2
+
3
+
Converts each codec to a [Wire.struct_] and [Wire.module_] for use with
4
+
[Wire.to_3d_file] to produce EverParse-compatible {e .3d} specifications. *)
5
+
6
+
open Spaceos_wire
7
+
8
+
(** {1 Frame} *)
9
+
10
+
let frame_struct = Wire.Codec.to_struct Msg.codec
11
+
12
+
let frame_module =
13
+
Wire.module_ ~doc:"SpaceOS fixed-size 256-byte frame" "SpaceOSFrame"
14
+
[ Wire.typedef ~entrypoint:true frame_struct ]
15
+
16
+
(** {1 Error Payload} *)
17
+
18
+
let error_payload_struct = Wire.Codec.to_struct Error_payload.codec
19
+
20
+
let error_payload_module =
21
+
Wire.module_ ~doc:"SpaceOS ERROR/NACK payload (8 bytes)" "ErrorPayload"
22
+
[ Wire.typedef ~entrypoint:true error_payload_struct ]
23
+
24
+
(** {1 DP Notification Payload} *)
25
+
26
+
let dp_payload_struct = Wire.Codec.to_struct Dp_payload.codec
27
+
28
+
let dp_payload_module =
29
+
Wire.module_ ~doc:"SpaceOS data-product notification payload (80 bytes)"
30
+
"DpPayload"
31
+
[ Wire.typedef ~entrypoint:true dp_payload_struct ]
32
+
33
+
(** {1 Superblock} *)
34
+
35
+
let superblock_struct = Wire.Codec.to_struct Superblock.codec
36
+
37
+
let superblock_module =
38
+
Wire.module_ ~doc:"SpaceOS superblock (block 0, 48 bytes)" "Superblock"
39
+
[ Wire.typedef ~entrypoint:true superblock_struct ]
40
+
41
+
(** {1 Parameter Entry} *)
42
+
43
+
let param_entry_struct = Wire.Codec.to_struct Param_entry.codec
44
+
45
+
let param_entry_module =
46
+
Wire.module_ ~doc:"SpaceOS parameter store entry (252 bytes)" "ParamEntry"
47
+
[ Wire.typedef ~entrypoint:true param_entry_struct ]
48
+
49
+
(** {1 Event Log} *)
50
+
51
+
let event_log_struct = Wire.Codec.to_struct Event_log.codec
52
+
53
+
let event_log_module =
54
+
Wire.module_ ~doc:"SpaceOS event log record (76 bytes)" "EventLog"
55
+
[ Wire.typedef ~entrypoint:true event_log_struct ]
56
+
57
+
(** {1 All Schemas} *)
58
+
59
+
let all_structs =
60
+
[
61
+
("SpaceOSFrame", frame_struct);
62
+
("ErrorPayload", error_payload_struct);
63
+
("DpPayload", dp_payload_struct);
64
+
("Superblock", superblock_struct);
65
+
("ParamEntry", param_entry_struct);
66
+
("EventLog", event_log_struct);
67
+
]
68
+
69
+
let all_modules =
70
+
[
71
+
("SpaceOSFrame", frame_module);
72
+
("ErrorPayload", error_payload_module);
73
+
("DpPayload", dp_payload_module);
74
+
("Superblock", superblock_module);
75
+
("ParamEntry", param_entry_module);
76
+
("EventLog", event_log_module);
77
+
]
+23
lib/wire/spaceos_wire_3d.mli
+23
lib/wire/spaceos_wire_3d.mli
···
1
+
(** SpaceOS Wire schemas for EverParse 3D generation.
2
+
3
+
Converts each codec to a [Wire.struct_] and [Wire.module_] for use with
4
+
[Wire.to_3d_file] to produce EverParse-compatible {e .3d} specifications. *)
5
+
6
+
val frame_struct : Wire.struct_
7
+
val frame_module : Wire.module_
8
+
val error_payload_struct : Wire.struct_
9
+
val error_payload_module : Wire.module_
10
+
val dp_payload_struct : Wire.struct_
11
+
val dp_payload_module : Wire.module_
12
+
val superblock_struct : Wire.struct_
13
+
val superblock_module : Wire.module_
14
+
val param_entry_struct : Wire.struct_
15
+
val param_entry_module : Wire.module_
16
+
val event_log_struct : Wire.struct_
17
+
val event_log_module : Wire.module_
18
+
19
+
val all_structs : (string * Wire.struct_) list
20
+
(** All schema structs, keyed by name. *)
21
+
22
+
val all_modules : (string * Wire.module_) list
23
+
(** All schema modules, keyed by name. *)
+32
spaceos-wire.opam
+32
spaceos-wire.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "SpaceOS wire protocol codecs"
4
+
description:
5
+
"Wire codecs for the SpaceOS host-guest communication protocol. Fixed-size frames, shared memory layout, and storage block codecs for F Prime integration."
6
+
maintainer: ["Thomas Gazagnaire"]
7
+
authors: ["Thomas Gazagnaire"]
8
+
license: "MIT"
9
+
depends: [
10
+
"dune" {>= "3.21"}
11
+
"ocaml" {>= "5.1"}
12
+
"wire"
13
+
"checkseum"
14
+
"alcotest" {with-test}
15
+
"crowbar" {with-test}
16
+
"odoc" {with-doc}
17
+
]
18
+
build: [
19
+
["dune" "subst"] {dev}
20
+
[
21
+
"dune"
22
+
"build"
23
+
"-p"
24
+
name
25
+
"-j"
26
+
jobs
27
+
"@install"
28
+
"@runtest" {with-test}
29
+
"@doc" {with-doc}
30
+
]
31
+
]
32
+
x-maintenance-intent: ["(latest)"]
+79
test/diff/dune
+79
test/diff/dune
···
1
+
; Differential testing: OCaml wire vs EverParse C parsers
2
+
;
3
+
; Workflow:
4
+
; 1. BUILD_EVERPARSE=1 dune build @spaceos-wire/test/diff/gen_c
5
+
; (generates .3d schemas, runs EverParse, produces C stubs)
6
+
; 2. BUILD_EVERPARSE=1 dune build @spaceos-wire/test/diff/diff
7
+
; (runs differential tests)
8
+
;
9
+
; EverParse is slow, so code generation only runs when BUILD_EVERPARSE=1.
10
+
; Generated C code can be promoted and committed for C API consumers.
11
+
12
+
; Generate .3d files from SpaceOS Wire codecs
13
+
14
+
(executable
15
+
(name gen_schemas)
16
+
(modules gen_schemas)
17
+
(enabled_if
18
+
(= %{env:BUILD_EVERPARSE=} "1"))
19
+
(libraries spaceos_wire_3d))
20
+
21
+
(rule
22
+
(alias gen_schemas)
23
+
(enabled_if
24
+
(= %{env:BUILD_EVERPARSE=} "1"))
25
+
(targets SpaceOSFrame.3d ErrorPayload.3d DpPayload.3d Superblock.3d)
26
+
(deps gen_schemas.exe)
27
+
(action
28
+
(run ./gen_schemas.exe)))
29
+
30
+
; Generate EverParse C code and differential test infrastructure
31
+
; Run with: BUILD_EVERPARSE=1 dune build @spaceos-wire/test/diff/gen_c
32
+
33
+
(executable
34
+
(name gen_c)
35
+
(modules gen_c)
36
+
(enabled_if
37
+
(= %{env:BUILD_EVERPARSE=} "1"))
38
+
(libraries spaceos_wire_3d wire.diff-gen))
39
+
40
+
(rule
41
+
(alias gen_c)
42
+
(enabled_if
43
+
(= %{env:BUILD_EVERPARSE=} "1"))
44
+
(targets
45
+
(dir schemas)
46
+
stubs.c
47
+
stubs.ml
48
+
diff_test.ml)
49
+
(deps gen_c.exe)
50
+
(action
51
+
(run ./gen_c.exe schemas)))
52
+
53
+
; Compile C stubs (includes EverParse generated C)
54
+
; NOTE: Only builds with BUILD_EVERPARSE=1 after running @gen_c first
55
+
56
+
(library
57
+
(name stubs)
58
+
(modules stubs)
59
+
(enabled_if
60
+
(= %{env:BUILD_EVERPARSE=} "1"))
61
+
(foreign_stubs
62
+
(language c)
63
+
(names stubs)
64
+
(flags :standard -I schemas)))
65
+
66
+
(executable
67
+
(name diff_test)
68
+
(modules diff_test)
69
+
(enabled_if
70
+
(= %{env:BUILD_EVERPARSE=} "1"))
71
+
(libraries stubs))
72
+
73
+
(rule
74
+
(alias diff)
75
+
(enabled_if
76
+
(= %{env:BUILD_EVERPARSE=} "1"))
77
+
(deps diff_test.exe)
78
+
(action
79
+
(run ./diff_test.exe)))
+16
test/diff/gen_c.ml
+16
test/diff/gen_c.ml
···
1
+
(** Generate EverParse C parsers and differential test infrastructure for
2
+
SpaceOS Wire codecs. Uses [wire.diff-gen] for the heavy lifting. *)
3
+
4
+
let schemas =
5
+
List.filter_map
6
+
(fun (name, module_) ->
7
+
match List.assoc_opt name Spaceos_wire_3d.all_structs with
8
+
| Some struct_ -> Wire_diff_gen.Diff_gen.schema ~name ~struct_ ~module_
9
+
| None -> None)
10
+
Spaceos_wire_3d.all_modules
11
+
12
+
let () =
13
+
let schema_dir =
14
+
if Array.length Sys.argv > 1 then Sys.argv.(1) else "schemas"
15
+
in
16
+
Wire_diff_gen.Diff_gen.generate ~schema_dir ~outdir:"." schemas
+6
test/diff/gen_schemas.ml
+6
test/diff/gen_schemas.ml
+309
test/test.ml
+309
test/test.ml
···
1
+
open Spaceos_wire
2
+
3
+
(* Helpers *)
4
+
let encode codec v =
5
+
let ws = Wire.Codec.wire_size codec in
6
+
let buf = Bytes.create ws in
7
+
Wire.Codec.encode codec v buf 0;
8
+
Bytes.unsafe_to_string buf
9
+
10
+
let decode codec s = Wire.Codec.decode codec (Bytes.of_string s) 0
11
+
12
+
(* === Frame tests === *)
13
+
14
+
let test_frame_roundtrip () =
15
+
let frame = Msg.v TM ~apid:0x42 "hello world" in
16
+
let encoded = encode Msg.codec frame in
17
+
Alcotest.(check int) "frame size" 256 (String.length encoded);
18
+
let decoded = decode Msg.codec encoded in
19
+
Alcotest.(check bool) "roundtrip" true (Msg.equal frame decoded)
20
+
21
+
let test_frame_header_layout () =
22
+
let frame = Msg.v TC ~apid:0x123 "test" in
23
+
let encoded = encode Msg.codec frame in
24
+
(* version=0x01 at offset 0 *)
25
+
Alcotest.(check int) "version" 0x01 (Char.code encoded.[0]);
26
+
(* type=0x01 (TC) at offset 1 *)
27
+
Alcotest.(check int) "type" 0x01 (Char.code encoded.[1]);
28
+
(* apid=0x0123 big-endian at offset 2-3 *)
29
+
Alcotest.(check int) "apid high" 0x01 (Char.code encoded.[2]);
30
+
Alcotest.(check int) "apid low" 0x23 (Char.code encoded.[3]);
31
+
(* payload_length=4 at offset 4-5 *)
32
+
Alcotest.(check int) "pay_len high" 0x00 (Char.code encoded.[4]);
33
+
Alcotest.(check int) "pay_len low" 0x04 (Char.code encoded.[5]);
34
+
(* reserved=0 at offset 6-7 *)
35
+
Alcotest.(check int) "reserved high" 0x00 (Char.code encoded.[6]);
36
+
Alcotest.(check int) "reserved low" 0x00 (Char.code encoded.[7]);
37
+
(* payload starts at offset 8 *)
38
+
Alcotest.(check char) "payload[0]" 't' encoded.[8]
39
+
40
+
let test_frame_all_types () =
41
+
let types =
42
+
Msg.[ TM; TC; EVR; PRM_GET; PRM_SET; PRM_RSP; DP; HEALTH; LOG; ERROR ]
43
+
in
44
+
List.iter
45
+
(fun typ ->
46
+
let frame = Msg.v typ ~apid:1 "" in
47
+
let encoded = encode Msg.codec frame in
48
+
let decoded = decode Msg.codec encoded in
49
+
let typ_int = Msg.msg_type_to_int typ in
50
+
Alcotest.(check int)
51
+
(Fmt.str "type %a" Msg.pp_msg_type typ)
52
+
typ_int decoded.msg_type)
53
+
types
54
+
55
+
let test_frame_payload_bytes () =
56
+
let frame = Msg.v TM ~apid:1 "abc" in
57
+
let encoded = encode Msg.codec frame in
58
+
let decoded = decode Msg.codec encoded in
59
+
Alcotest.(check string) "payload_bytes" "abc" (Msg.payload_bytes decoded)
60
+
61
+
let test_frame_max_payload () =
62
+
let big = String.make 300 'x' in
63
+
let frame = Msg.v TM ~apid:1 big in
64
+
Alcotest.(check int) "payload_length capped" 248 frame.payload_length
65
+
66
+
(* === Error payload tests === *)
67
+
68
+
let test_error_roundtrip () =
69
+
let err =
70
+
Error_payload.v Unknown_type ~offending_type:0xFF ~offending_apid:0x42
71
+
~offending_pay_len:248
72
+
in
73
+
let encoded = encode Error_payload.codec err in
74
+
Alcotest.(check int) "error size" 8 (String.length encoded);
75
+
let decoded = decode Error_payload.codec encoded in
76
+
Alcotest.(check bool) "roundtrip" true (Error_payload.equal err decoded)
77
+
78
+
let test_error_layout () =
79
+
let err =
80
+
Error_payload.v Host_busy ~offending_type:0x07 ~offending_apid:0x100
81
+
~offending_pay_len:0x1234
82
+
in
83
+
let encoded = encode Error_payload.codec err in
84
+
Alcotest.(check int) "error_code" 0x05 (Char.code encoded.[0]);
85
+
Alcotest.(check int) "offending_type" 0x07 (Char.code encoded.[1]);
86
+
(* apid 0x0100 big-endian *)
87
+
Alcotest.(check int) "apid high" 0x01 (Char.code encoded.[2]);
88
+
Alcotest.(check int) "apid low" 0x00 (Char.code encoded.[3]);
89
+
(* pay_len 0x1234 big-endian at offset 4-5 *)
90
+
Alcotest.(check int) "pay_len high" 0x12 (Char.code encoded.[4]);
91
+
Alcotest.(check int) "pay_len low" 0x34 (Char.code encoded.[5]);
92
+
(* reserved = 0 at offset 6-7 *)
93
+
Alcotest.(check int) "reserved high" 0x00 (Char.code encoded.[6]);
94
+
Alcotest.(check int) "reserved low" 0x00 (Char.code encoded.[7])
95
+
96
+
(* === DP payload tests === *)
97
+
98
+
let test_dp_roundtrip () =
99
+
let dp =
100
+
Dp_payload.v ~block_offset:100 ~block_count:10 ~dp_class:1 ~priority:2
101
+
~name:"science.dat" ~crc32:0xDEADBEEF
102
+
in
103
+
let encoded = encode Dp_payload.codec dp in
104
+
Alcotest.(check int) "dp size" 80 (String.length encoded);
105
+
let decoded = decode Dp_payload.codec encoded in
106
+
Alcotest.(check int) "block_offset" 100 decoded.block_offset;
107
+
Alcotest.(check int) "block_count" 10 decoded.block_count;
108
+
Alcotest.(check int) "dp_class" 1 decoded.dp_class;
109
+
Alcotest.(check int) "priority" 2 decoded.priority;
110
+
Alcotest.(check string)
111
+
"name_string" "science.dat"
112
+
(Dp_payload.name_string decoded);
113
+
Alcotest.(check int) "crc32" 0xDEADBEEF decoded.crc32
114
+
115
+
(* === Superblock tests === *)
116
+
117
+
let test_superblock_roundtrip () =
118
+
let sb =
119
+
Superblock.v ~tenant_id:1 ~total_blocks:1024 ~dp_start:33 ~dp_size:991
120
+
~epoch:1000000L ~uuid:(String.make 16 '\xAB')
121
+
in
122
+
let encoded = encode Superblock.codec sb in
123
+
Alcotest.(check int) "superblock size" 48 (String.length encoded);
124
+
let decoded = decode Superblock.codec encoded in
125
+
Alcotest.(check bool) "roundtrip" true (Superblock.equal sb decoded)
126
+
127
+
let test_superblock_magic () =
128
+
let sb =
129
+
Superblock.v ~tenant_id:1 ~total_blocks:1024 ~dp_start:33 ~dp_size:991
130
+
~epoch:0L ~uuid:(String.make 16 '\x00')
131
+
in
132
+
Alcotest.(check bool) "magic ok" true (Superblock.check_magic sb);
133
+
let bad = { sb with magic = 0 } in
134
+
Alcotest.(check bool) "magic bad" false (Superblock.check_magic bad)
135
+
136
+
let test_superblock_crc () =
137
+
let sb =
138
+
Superblock.v ~tenant_id:1 ~total_blocks:1024 ~dp_start:33 ~dp_size:991
139
+
~epoch:0L ~uuid:(String.make 16 '\x00')
140
+
in
141
+
Alcotest.(check bool) "crc ok" true (Superblock.check_crc sb);
142
+
let bad = { sb with tenant_id = 999 } in
143
+
Alcotest.(check bool) "crc bad" false (Superblock.check_crc bad)
144
+
145
+
let test_superblock_layout () =
146
+
let sb =
147
+
Superblock.v ~tenant_id:1 ~total_blocks:1024 ~dp_start:33 ~dp_size:991
148
+
~epoch:0L ~uuid:(String.make 16 '\x00')
149
+
in
150
+
let encoded = encode Superblock.codec sb in
151
+
(* magic = 0x53504F53 big-endian *)
152
+
Alcotest.(check int) "magic[0]" 0x53 (Char.code encoded.[0]);
153
+
Alcotest.(check int) "magic[1]" 0x50 (Char.code encoded.[1]);
154
+
Alcotest.(check int) "magic[2]" 0x4F (Char.code encoded.[2]);
155
+
Alcotest.(check int) "magic[3]" 0x53 (Char.code encoded.[3]);
156
+
(* format_version = 0x01 at offset 4 *)
157
+
Alcotest.(check int) "version" 0x01 (Char.code encoded.[4])
158
+
159
+
(* === Parameter entry tests === *)
160
+
161
+
let test_param_entry_roundtrip () =
162
+
let p = Param_entry.v ~param_id:42 ~generation:7 "hello" in
163
+
let encoded = encode Param_entry.codec p in
164
+
Alcotest.(check int) "param size" 252 (String.length encoded);
165
+
let decoded = decode Param_entry.codec encoded in
166
+
Alcotest.(check bool) "roundtrip" true (Param_entry.equal p decoded)
167
+
168
+
let test_param_entry_crc () =
169
+
let p = Param_entry.v ~param_id:42 ~generation:1 "value" in
170
+
Alcotest.(check bool) "crc ok" true (Param_entry.check_crc p);
171
+
let bad = { p with Param_entry.param_id = 999 } in
172
+
Alcotest.(check bool) "crc bad" false (Param_entry.check_crc bad)
173
+
174
+
let test_param_entry_layout () =
175
+
let p = Param_entry.v ~param_id:0x01020304 ~generation:3 "AB" in
176
+
let encoded = encode Param_entry.codec p in
177
+
(* param_id = 0x01020304 big-endian at offset 0-3 *)
178
+
Alcotest.(check int) "pid[0]" 0x01 (Char.code encoded.[0]);
179
+
Alcotest.(check int) "pid[1]" 0x02 (Char.code encoded.[1]);
180
+
Alcotest.(check int) "pid[2]" 0x03 (Char.code encoded.[2]);
181
+
Alcotest.(check int) "pid[3]" 0x04 (Char.code encoded.[3]);
182
+
(* len=2 at offset 4-5 *)
183
+
Alcotest.(check int) "len high" 0x00 (Char.code encoded.[4]);
184
+
Alcotest.(check int) "len low" 0x02 (Char.code encoded.[5]);
185
+
(* generation=3 at offset 6-7 *)
186
+
Alcotest.(check int) "gen high" 0x00 (Char.code encoded.[6]);
187
+
Alcotest.(check int) "gen low" 0x03 (Char.code encoded.[7]);
188
+
(* value starts at offset 8 *)
189
+
Alcotest.(check char) "value[0]" 'A' encoded.[8];
190
+
Alcotest.(check char) "value[1]" 'B' encoded.[9]
191
+
192
+
(* === Event log tests === *)
193
+
194
+
let test_event_log_roundtrip () =
195
+
let ev = Event_log.v ~timestamp:1000 INFO ~event_code:0x42 "boot ok" in
196
+
let encoded = encode Event_log.codec ev in
197
+
Alcotest.(check int) "event size" 76 (String.length encoded);
198
+
let decoded = decode Event_log.codec encoded in
199
+
Alcotest.(check bool) "roundtrip" true (Event_log.equal ev decoded)
200
+
201
+
let test_event_log_payload_bytes () =
202
+
let ev = Event_log.v ~timestamp:0 DEBUG ~event_code:1 "hello" in
203
+
let encoded = encode Event_log.codec ev in
204
+
let decoded = decode Event_log.codec encoded in
205
+
Alcotest.(check string)
206
+
"payload_bytes" "hello"
207
+
(Event_log.payload_bytes decoded)
208
+
209
+
let test_event_log_layout () =
210
+
let ev = Event_log.v ~timestamp:0x12345678 WARNING ~event_code:0xABCD "X" in
211
+
let encoded = encode Event_log.codec ev in
212
+
(* timestamp = 0x12345678 big-endian *)
213
+
Alcotest.(check int) "ts[0]" 0x12 (Char.code encoded.[0]);
214
+
Alcotest.(check int) "ts[1]" 0x34 (Char.code encoded.[1]);
215
+
Alcotest.(check int) "ts[2]" 0x56 (Char.code encoded.[2]);
216
+
Alcotest.(check int) "ts[3]" 0x78 (Char.code encoded.[3]);
217
+
(* severity=2 (WARNING) at offset 4 *)
218
+
Alcotest.(check int) "severity" 0x02 (Char.code encoded.[4]);
219
+
(* reserved=0 at offset 5 *)
220
+
Alcotest.(check int) "reserved" 0x00 (Char.code encoded.[5]);
221
+
(* event_code=0xABCD at offset 6-7 *)
222
+
Alcotest.(check int) "code high" 0xAB (Char.code encoded.[6]);
223
+
Alcotest.(check int) "code low" 0xCD (Char.code encoded.[7]);
224
+
(* payload_len=1 at offset 8-9 *)
225
+
Alcotest.(check int) "plen high" 0x00 (Char.code encoded.[8]);
226
+
Alcotest.(check int) "plen low" 0x01 (Char.code encoded.[9])
227
+
228
+
(* === Shared memory tests === *)
229
+
230
+
let test_shared_mem_heartbeat () =
231
+
let buf = Bytes.make Shared_mem.page_size '\x00' in
232
+
Shared_mem.set_heartbeat buf 42L;
233
+
Alcotest.(check int64) "heartbeat" 42L (Shared_mem.get_heartbeat buf)
234
+
235
+
let test_shared_mem_mission_time () =
236
+
let buf = Bytes.make Shared_mem.page_size '\x00' in
237
+
let t = Shared_mem.{ seconds = 1000L; nanos = 500_000_000 } in
238
+
Shared_mem.write_mission_time buf t;
239
+
let t' = Shared_mem.read_mission_time buf in
240
+
Alcotest.(check int64) "seconds" t.seconds t'.seconds;
241
+
Alcotest.(check int) "nanos" t.nanos t'.nanos;
242
+
(* time_version should be even after write *)
243
+
let v = Shared_mem.get_time_version buf in
244
+
Alcotest.(check bool) "version even" true (v land 1 = 0);
245
+
Alcotest.(check bool) "version > 0" true (v > 0)
246
+
247
+
let test_shared_mem_health_string () =
248
+
let buf = Bytes.make Shared_mem.page_size '\x00' in
249
+
Shared_mem.set_health_string buf "nominal";
250
+
Alcotest.(check string) "health" "nominal" (Shared_mem.get_health_string buf)
251
+
252
+
let test_shared_mem_command_word () =
253
+
let buf = Bytes.make Shared_mem.page_size '\x00' in
254
+
Shared_mem.set_host_cmd buf Shared_mem.cmd_shutdown;
255
+
let cmd = Shared_mem.get_host_cmd buf in
256
+
Alcotest.(check bool)
257
+
"shutdown set" true
258
+
(cmd land Shared_mem.cmd_shutdown <> 0);
259
+
Alcotest.(check bool)
260
+
"param_reload clear" true
261
+
(cmd land Shared_mem.cmd_param_reload = 0)
262
+
263
+
(* === Test runner === *)
264
+
265
+
let () =
266
+
Alcotest.run "spaceos-wire"
267
+
[
268
+
( "frame",
269
+
[
270
+
Alcotest.test_case "roundtrip" `Quick test_frame_roundtrip;
271
+
Alcotest.test_case "header layout" `Quick test_frame_header_layout;
272
+
Alcotest.test_case "all types" `Quick test_frame_all_types;
273
+
Alcotest.test_case "payload_bytes" `Quick test_frame_payload_bytes;
274
+
Alcotest.test_case "max payload" `Quick test_frame_max_payload;
275
+
] );
276
+
( "error",
277
+
[
278
+
Alcotest.test_case "roundtrip" `Quick test_error_roundtrip;
279
+
Alcotest.test_case "layout" `Quick test_error_layout;
280
+
] );
281
+
("dp", [ Alcotest.test_case "roundtrip" `Quick test_dp_roundtrip ]);
282
+
( "param_entry",
283
+
[
284
+
Alcotest.test_case "roundtrip" `Quick test_param_entry_roundtrip;
285
+
Alcotest.test_case "crc" `Quick test_param_entry_crc;
286
+
Alcotest.test_case "layout" `Quick test_param_entry_layout;
287
+
] );
288
+
( "event_log",
289
+
[
290
+
Alcotest.test_case "roundtrip" `Quick test_event_log_roundtrip;
291
+
Alcotest.test_case "payload_bytes" `Quick test_event_log_payload_bytes;
292
+
Alcotest.test_case "layout" `Quick test_event_log_layout;
293
+
] );
294
+
( "superblock",
295
+
[
296
+
Alcotest.test_case "roundtrip" `Quick test_superblock_roundtrip;
297
+
Alcotest.test_case "magic" `Quick test_superblock_magic;
298
+
Alcotest.test_case "crc" `Quick test_superblock_crc;
299
+
Alcotest.test_case "layout" `Quick test_superblock_layout;
300
+
] );
301
+
( "shared_mem",
302
+
[
303
+
Alcotest.test_case "heartbeat" `Quick test_shared_mem_heartbeat;
304
+
Alcotest.test_case "mission time" `Quick test_shared_mem_mission_time;
305
+
Alcotest.test_case "health string" `Quick
306
+
test_shared_mem_health_string;
307
+
Alcotest.test_case "command word" `Quick test_shared_mem_command_word;
308
+
] );
309
+
]