CCSDS USLP (Unified Space Link Protocol) Transfer Frame- unified TM/TC/AOS
feat(ccsds): add Wire.Codec to TC, AOS, USLP; extend TM and migrate CLCW
Add packed_header types and Wire.Codec definitions to TC, AOS, and USLP
protocols, enabling EverParse 3D output and C FFI stub generation. Extend
TM's existing Wire.Codec with wire helpers and FFI stubs, and migrate its
duplicate CLCW implementation to use the shared Clcw library.
+249
-7
+1
-1
lib/dune
+1
-1
lib/dune
+143
-5
lib/uslp.ml
+143
-5
lib/uslp.ml
···
444
444
| Source -> Format.fprintf ppf "Source"
445
445
| Dest -> Format.fprintf ppf "Dest"
446
446
447
-
let pp_header ppf hdr =
447
+
let pp_header ppf (hdr : header) =
448
448
Format.fprintf ppf
449
449
"@[<hv 2>{ tfvn=%d;@ scid=%d;@ %a;@ vcid=%d;@ map_id=%d;@ vcfc=%d }@]"
450
450
hdr.tfvn hdr.scid pp_src_or_dest hdr.src_or_dest hdr.vcid hdr.map_id
451
451
hdr.vcfc
452
452
453
-
let pp ppf frame =
453
+
let pp ppf (frame : t) =
454
454
Format.fprintf ppf "@[<v 2>USLP_frame %a@ data[%d bytes]%a%a%a@]" pp_header
455
455
frame.header (String.length frame.data)
456
456
(fun ppf -> function
···
465
465
| Some f -> Format.fprintf ppf "@ fecf=0x%Lx" f | None -> ())
466
466
frame.fecf
467
467
468
-
let equal_header a b =
468
+
let equal_header (a : header) (b : header) =
469
469
a.tfvn = b.tfvn && a.scid = b.scid
470
470
&& a.src_or_dest = b.src_or_dest
471
471
&& a.vcid = b.vcid && a.map_id = b.map_id && a.eofph = b.eofph
···
485
485
&& a.insert_zone = b.insert_zone
486
486
&& a.data = b.data && ocf_equal a.ocf b.ocf
487
487
488
+
(* {1 Packed Header Wire Representation} *)
489
+
490
+
type packed_header = {
491
+
tfvn : int;
492
+
scid : int;
493
+
src_or_dest : src_or_dest;
494
+
vcid : int;
495
+
map_id : int;
496
+
eofph : bool;
497
+
frame_len : int;
498
+
bypass_flag : bool;
499
+
prot_ctrl_cmd : bool;
500
+
ocf_flag : bool;
501
+
vcfc_len : int;
502
+
}
503
+
504
+
let equal_packed_header a b =
505
+
a.tfvn = b.tfvn && a.scid = b.scid
506
+
&& a.src_or_dest = b.src_or_dest
507
+
&& a.vcid = b.vcid && a.map_id = b.map_id && a.eofph = b.eofph
508
+
&& a.frame_len = b.frame_len
509
+
&& a.bypass_flag = b.bypass_flag
510
+
&& a.prot_ctrl_cmd = b.prot_ctrl_cmd
511
+
&& a.ocf_flag = b.ocf_flag && a.vcfc_len = b.vcfc_len
512
+
513
+
(* Wire Codec *)
514
+
let codec =
515
+
let open Wire.Codec in
516
+
let bits32 n = Wire.bits ~width:n Wire.bf_uint32be in
517
+
let bits8 n = Wire.bits ~width:n Wire.bf_uint8 in
518
+
let bool32 = Wire.bool (bits32 1) in
519
+
let bool8 = Wire.bool (bits8 1) in
520
+
let src_dest = Wire.cases [ Source; Dest ] (bits32 1) in
521
+
record "UslpHeader"
522
+
(fun tfvn scid sd vcid map_id eofph flen bypass pcc _rsvd ocf vcfc_len ->
523
+
{
524
+
tfvn;
525
+
scid;
526
+
src_or_dest = sd;
527
+
vcid;
528
+
map_id;
529
+
eofph;
530
+
frame_len = flen;
531
+
bypass_flag = bypass;
532
+
prot_ctrl_cmd = pcc;
533
+
ocf_flag = ocf;
534
+
vcfc_len;
535
+
})
536
+
|+ field "tfvn" (bits32 4) (fun t -> t.tfvn)
537
+
|+ field "scid" (bits32 16) (fun t -> t.scid)
538
+
|+ field "src_or_dest" src_dest (fun t -> t.src_or_dest)
539
+
|+ field "vcid" (bits32 6) (fun t -> t.vcid)
540
+
|+ field "map_id" (bits32 4) (fun t -> t.map_id)
541
+
|+ field "eofph" bool32 (fun t -> t.eofph)
542
+
|+ field "frame_len" Wire.uint16be (fun t -> t.frame_len)
543
+
|+ field "bypass_flag" bool8 (fun t -> t.bypass_flag)
544
+
|+ field "prot_ctrl_cmd" bool8 (fun t -> t.prot_ctrl_cmd)
545
+
|+ field "reserved" (bits8 2) (fun _ -> 0)
546
+
|+ field "ocf_flag" bool8 (fun t -> t.ocf_flag)
547
+
|+ field "vcfc_len" (bits8 3) (fun t -> t.vcfc_len)
548
+
|> seal
549
+
550
+
let struct_ = Wire.Codec.to_struct codec
551
+
552
+
let module_ =
553
+
Wire.module_ ~doc:"CCSDS USLP Transfer Frame Primary Header (732.1-B-2)"
554
+
"UslpHeader"
555
+
[ Wire.typedef ~entrypoint:true struct_ ]
556
+
557
+
(* Wire Parse/Encode *)
558
+
let wire_size = Wire.Codec.wire_size codec
559
+
560
+
let decode_bytes buf =
561
+
if Bytes.length buf < wire_size then
562
+
Error (Wire.Unexpected_eof { expected = wire_size; got = Bytes.length buf })
563
+
else Ok (Wire.Codec.decode codec buf 0)
564
+
565
+
let decode_string s =
566
+
if String.length s < wire_size then
567
+
Error (Wire.Unexpected_eof { expected = wire_size; got = String.length s })
568
+
else Ok (Wire.Codec.decode codec (Bytes.of_string s) 0)
569
+
570
+
let encode_string t =
571
+
let buf = Bytes.create wire_size in
572
+
Wire.Codec.encode codec t buf 0;
573
+
Bytes.unsafe_to_string buf
574
+
575
+
let encode_bytes t =
576
+
let buf = Bytes.create wire_size in
577
+
Wire.Codec.encode codec t buf 0;
578
+
buf
579
+
580
+
let to_packed_header (h : header) : packed_header =
581
+
{
582
+
tfvn = h.tfvn;
583
+
scid = scid_to_int h.scid;
584
+
src_or_dest = h.src_or_dest;
585
+
vcid = vcid_to_int h.vcid;
586
+
map_id = map_id_to_int h.map_id;
587
+
eofph = h.eofph;
588
+
frame_len = h.frame_len;
589
+
bypass_flag = h.bypass_flag;
590
+
prot_ctrl_cmd = h.prot_ctrl_cmd;
591
+
ocf_flag = h.ocf_flag;
592
+
vcfc_len = h.vcfc_len;
593
+
}
594
+
595
+
let of_packed_header (p : packed_header) :
596
+
(header, [ `Invalid_scid | `Invalid_vcid | `Invalid_map_id ]) result =
597
+
match scid p.scid with
598
+
| None -> Error `Invalid_scid
599
+
| Some scid_val -> (
600
+
match vcid p.vcid with
601
+
| None -> Error `Invalid_vcid
602
+
| Some vcid_val -> (
603
+
match map_id p.map_id with
604
+
| None -> Error `Invalid_map_id
605
+
| Some map_id_val ->
606
+
Ok
607
+
{
608
+
tfvn = p.tfvn;
609
+
scid = scid_val;
610
+
src_or_dest = p.src_or_dest;
611
+
vcid = vcid_val;
612
+
map_id = map_id_val;
613
+
eofph = p.eofph;
614
+
frame_len = p.frame_len;
615
+
bypass_flag = p.bypass_flag;
616
+
prot_ctrl_cmd = p.prot_ctrl_cmd;
617
+
ocf_flag = p.ocf_flag;
618
+
vcfc_len = p.vcfc_len;
619
+
vcfc = 0;
620
+
}))
621
+
622
+
(* FFI Code Generation *)
623
+
let c_stubs () = Wire.to_c_stubs [ struct_ ]
624
+
let ml_stubs () = Wire.to_ml_stubs [ struct_ ]
625
+
488
626
(* {1 Constructors} *)
489
627
490
628
let v ?(tfvn = tfvn_uslp) ?(src_or_dest = Source) ?(eofph = false)
491
629
?(bypass_flag = false) ?(prot_ctrl_cmd = false) ?(insert_zone = None)
492
630
?(ocf = None) ?(fecf = None) ~scid ~vcid ~map_id ~vcfc ~vcfc_len data =
493
-
let header =
631
+
let header : header =
494
632
{
495
633
tfvn;
496
634
scid = scid land 0xFFFF;
···
522
660
?(bypass_flag = false) ?(prot_ctrl_cmd = false) ?(insert_zone = None)
523
661
?(fecf = None) ~scid ~vcid ~map_id ~vcfc ~vcfc_len ~clcw data =
524
662
let ocf = Some (Clcw.encode clcw) in
525
-
let header =
663
+
let header : header =
526
664
{
527
665
tfvn;
528
666
scid = scid land 0xFFFF;
+45
lib/uslp.mli
+45
lib/uslp.mli
···
188
188
t
189
189
(** [with_clcw ~scid ~vcid ~map_id ~vcfc ~vcfc_len ~clcw data] constructs a USLP
190
190
frame with CLCW. *)
191
+
192
+
(** {1 Packed Header Wire Representation} *)
193
+
194
+
type packed_header = {
195
+
tfvn : int; (** Transfer Frame Version Number (4 bits). *)
196
+
scid : int; (** Spacecraft ID (16 bits). *)
197
+
src_or_dest : src_or_dest; (** Source or destination (1 bit). *)
198
+
vcid : int; (** Virtual channel ID (6 bits). *)
199
+
map_id : int; (** MAP ID (4 bits). *)
200
+
eofph : bool; (** End of Frame Primary Header (1 bit). *)
201
+
frame_len : int; (** Frame length - 1 (16 bits). *)
202
+
bypass_flag : bool; (** Bypass flag (1 bit). *)
203
+
prot_ctrl_cmd : bool; (** Protocol Control Command (1 bit). *)
204
+
ocf_flag : bool; (** OCF present flag (1 bit). *)
205
+
vcfc_len : int; (** VCFC length in bytes (3 bits). *)
206
+
}
207
+
(** USLP fixed header with typed fields (7 bytes wire). VCFC (variable 0-7
208
+
bytes) is not included. *)
209
+
210
+
val to_packed_header : header -> packed_header
211
+
212
+
val of_packed_header :
213
+
packed_header ->
214
+
(header, [ `Invalid_scid | `Invalid_vcid | `Invalid_map_id ]) result
215
+
216
+
val equal_packed_header : packed_header -> packed_header -> bool
217
+
218
+
(** {1 Wire Codec} *)
219
+
220
+
val codec : packed_header Wire.Codec.t
221
+
val struct_ : Wire.struct_
222
+
val module_ : Wire.module_
223
+
224
+
(** {1 Wire Parse/Encode} *)
225
+
226
+
val wire_size : int
227
+
val decode_bytes : bytes -> (packed_header, Wire.parse_error) result
228
+
val decode_string : string -> (packed_header, Wire.parse_error) result
229
+
val encode_string : packed_header -> string
230
+
val encode_bytes : packed_header -> bytes
231
+
232
+
(** {1 FFI Code Generation} *)
233
+
234
+
val c_stubs : unit -> string
235
+
val ml_stubs : unit -> string
+1
-1
test/dune
+1
-1
test/dune
+59
test/test_uslp.ml
+59
test/test_uslp.ml
···
117
117
"map_id 16 invalid" true
118
118
(Option.is_none (Uslp.map_id 16))
119
119
120
+
(* Wire codec tests *)
121
+
122
+
let packed_header_testable =
123
+
Alcotest.testable
124
+
(fun ppf h ->
125
+
Format.fprintf ppf
126
+
"{tfvn=%d scid=%d %a vcid=%d map=%d eofph=%b flen=%d bypass=%b pcc=%b \
127
+
ocf=%b vcfc_len=%d}"
128
+
h.Uslp.tfvn h.scid Uslp.pp_src_or_dest h.src_or_dest h.vcid h.map_id
129
+
h.eofph h.frame_len h.bypass_flag h.prot_ctrl_cmd h.ocf_flag h.vcfc_len)
130
+
Uslp.equal_packed_header
131
+
132
+
let test_wire_roundtrip () =
133
+
let packed =
134
+
{
135
+
Uslp.tfvn = 0xC;
136
+
scid = 1000;
137
+
src_or_dest = Uslp.Source;
138
+
vcid = 5;
139
+
map_id = 3;
140
+
eofph = false;
141
+
frame_len = 100;
142
+
bypass_flag = true;
143
+
prot_ctrl_cmd = false;
144
+
ocf_flag = false;
145
+
vcfc_len = 2;
146
+
}
147
+
in
148
+
let buf = Uslp.encode_string packed in
149
+
Alcotest.(check int) "wire_size" 7 Uslp.wire_size;
150
+
Alcotest.(check int) "encoded length" 7 (String.length buf);
151
+
match Uslp.decode_string buf with
152
+
| Error e -> Alcotest.failf "decode failed: %a" Wire.pp_parse_error e
153
+
| Ok decoded ->
154
+
Alcotest.check packed_header_testable "wire roundtrip" packed decoded
155
+
156
+
let test_wire_vs_manual () =
157
+
let scid = Uslp.scid_exn 1000 in
158
+
let vcid = Uslp.vcid_exn 5 in
159
+
let map_id = Uslp.map_id_exn 3 in
160
+
let frame =
161
+
Uslp.v ~scid ~vcid ~map_id ~vcfc:0 ~vcfc_len:0 ~src_or_dest:Uslp.Dest
162
+
~bypass_flag:true "data"
163
+
in
164
+
let encoded = Uslp.encode frame in
165
+
let manual = String.sub encoded 0 7 in
166
+
(* frame_len is computed during encode, so decode to get correct header *)
167
+
match Uslp.decode encoded with
168
+
| Error e -> Alcotest.failf "decode failed: %a" Uslp.pp_error e
169
+
| Ok decoded_frame ->
170
+
let packed = Uslp.to_packed_header decoded_frame.header in
171
+
let wire = Uslp.encode_string packed in
172
+
Alcotest.(check string) "wire=manual" manual wire
173
+
120
174
let () =
121
175
Alcotest.run "uslp"
122
176
[
···
135
189
Alcotest.test_case "vcid_bounds" `Quick test_vcid_bounds;
136
190
Alcotest.test_case "scid_bounds" `Quick test_scid_bounds;
137
191
Alcotest.test_case "map_id_bounds" `Quick test_map_id_bounds;
192
+
] );
193
+
( "wire",
194
+
[
195
+
Alcotest.test_case "wire_roundtrip" `Quick test_wire_roundtrip;
196
+
Alcotest.test_case "wire_vs_manual" `Quick test_wire_vs_manual;
138
197
] );
139
198
]