Licklider Transmission Protocol (CCSDS 734.1-B) for reliable DTN links
Wire.bool→Wire.bit rename; cfdp/ltp adopt wire; dune fmt
- CCSDS packages (aos, clcw, fsr, sdls, space-packet, tc, tm, uslp):
Wire.bool renamed to Wire.bit upstream; mechanical migration.
- ocaml-cfdp: adopt wire library for PDU header codec.
- ocaml-ltp: adopt wire library for segment header codec.
- ocaml-cop1: simplify interop test error formatting.
- dune fmt: reformat irmin, pus, scitt, crypto, tc/uslp 3D specs.
- monopam: add TODO.md tracking cram coverage gaps.
+68
-27
+1
dune-project
+1
dune-project
+1
-1
lib/dune
+1
-1
lib/dune
+65
-26
lib/ltp.ml
+65
-26
lib/ltp.ml
···
249
249
| Extension_error msg -> Fmt.pf ppf "extension error: %s" msg
250
250
| Content_error msg -> Fmt.pf ppf "content error: %s" msg
251
251
252
+
(* {1 Wire codec for the bitfield bytes}
253
+
254
+
LTP segments are mostly SDNV-encoded so there is no fixed-layout primary
255
+
header. The only bitfield-packed bytes are the 1-byte control header
256
+
(version + type code) and the 1-byte extension count header
257
+
(header count + trailer count). Both are a 4+4 split in a single byte
258
+
with the high nibble at bits 4-7 and the low nibble at bits 0-3, so we
259
+
share one codec. *)
260
+
261
+
type packed_nibbles = { pf_high : int; pf_low : int }
262
+
263
+
let bits8 n = Wire.bits ~width:n Wire.U8
264
+
let w_nibble_high = Wire.Field.v "high" (bits8 4)
265
+
let w_nibble_low = Wire.Field.v "low" (bits8 4)
266
+
267
+
let nibbles_codec =
268
+
Wire.Codec.v "LtpNibbleByte"
269
+
(fun high low -> { pf_high = high; pf_low = low })
270
+
Wire.Codec.
271
+
[
272
+
(w_nibble_high $ fun n -> n.pf_high); (w_nibble_low $ fun n -> n.pf_low);
273
+
]
274
+
275
+
let nibbles_size = Wire.Codec.wire_size nibbles_codec
276
+
277
+
let encode_nibbles ~high ~low =
278
+
let buf = Bytes.create nibbles_size in
279
+
Wire.Codec.encode nibbles_codec { pf_high = high; pf_low = low } buf 0;
280
+
Bytes.unsafe_to_string buf
281
+
282
+
let decode_nibbles s off =
283
+
if String.length s - off < nibbles_size then None
284
+
else
285
+
match Wire.Codec.decode nibbles_codec (Bytes.unsafe_of_string s) off with
286
+
| Ok n -> Some n
287
+
| Error _ -> None
288
+
252
289
(* {1 Encoding} *)
253
290
254
291
let encode_extension ext =
···
290
327
291
328
let encode_segment seg =
292
329
let buf = Buffer.create 128 in
293
-
(* Control byte: version (4 bits) + type flags (4 bits) *)
330
+
(* Control byte: version (4 bits) + type code (4 bits) — version 0 *)
294
331
let type_code = segment_type_to_int seg.segment_type in
295
-
let control_byte = type_code in
296
-
(* version 0 *)
297
-
Buffer.add_char buf (Char.chr control_byte);
332
+
Buffer.add_string buf (encode_nibbles ~high:0 ~low:type_code);
298
333
(* Session ID *)
299
334
Buffer.add_string buf (encode_sdnv seg.session_id.originator);
300
335
Buffer.add_string buf (encode_sdnv seg.session_id.number);
301
336
(* Extension counts *)
302
337
let hdr_count = List.length seg.header_extensions land 0x0F in
303
338
let trl_count = List.length seg.trailer_extensions land 0x0F in
304
-
Buffer.add_char buf (Char.chr ((hdr_count lsl 4) lor trl_count));
339
+
Buffer.add_string buf (encode_nibbles ~high:hdr_count ~low:trl_count);
305
340
(* Header extensions *)
306
341
Buffer.add_string buf (encode_extensions seg.header_extensions);
307
342
(* Content *)
···
417
452
let len = String.length buf in
418
453
if len < 3 then Error (Truncated { expected = 3; got = len })
419
454
else
420
-
let control = Char.code (String.get buf 0) in
421
-
let version = (control lsr 4) land 0x0F in
422
-
if version <> 0 then Error (Invalid_version version)
423
-
else
424
-
let type_code = control land 0x0F in
425
-
match segment_type_of_int type_code with
426
-
| None -> Error (Invalid_segment_type type_code)
427
-
| Some segment_type ->
428
-
let* originator, off =
429
-
decode_sdnv buf 1 |> Result.map_error (fun _ -> Invalid_sdnv)
430
-
in
431
-
let* number, off =
432
-
decode_sdnv buf off |> Result.map_error (fun _ -> Invalid_sdnv)
433
-
in
434
-
let session_id = { originator; number } in
435
-
if off >= len then Error (Truncated { expected = off + 1; got = len })
436
-
else
437
-
let ext_byte = Char.code (String.get buf off) in
438
-
let hdr_count = (ext_byte lsr 4) land 0x0F in
439
-
let trl_count = ext_byte land 0x0F in
440
-
Ok (segment_type, session_id, hdr_count, trl_count, off + 1)
455
+
match decode_nibbles buf 0 with
456
+
| None -> Error (Truncated { expected = 3; got = len })
457
+
| Some control -> (
458
+
if control.pf_high <> 0 then Error (Invalid_version control.pf_high)
459
+
else
460
+
let type_code = control.pf_low in
461
+
match segment_type_of_int type_code with
462
+
| None -> Error (Invalid_segment_type type_code)
463
+
| Some segment_type -> (
464
+
let* originator, off =
465
+
decode_sdnv buf 1 |> Result.map_error (fun _ -> Invalid_sdnv)
466
+
in
467
+
let* number, off =
468
+
decode_sdnv buf off |> Result.map_error (fun _ -> Invalid_sdnv)
469
+
in
470
+
let session_id = { originator; number } in
471
+
match decode_nibbles buf off with
472
+
| None -> Error (Truncated { expected = off + 1; got = len })
473
+
| Some ext ->
474
+
Ok
475
+
( segment_type,
476
+
session_id,
477
+
ext.pf_high,
478
+
ext.pf_low,
479
+
off + nibbles_size )))
441
480
442
481
let decode_segment buf =
443
482
let len = String.length buf in