CCSDS USLP (Unified Space Link Protocol) Transfer Frame- unified TM/TC/AOS
refactor(uslp): doc style, test convention
- Add periods to doc comments (E410)
- Apply E600 test module convention
+116
-110
+48
-79
lib/uslp.ml
+48
-79
lib/uslp.ml
···
113
113
114
114
(* {1 Binary helpers} *)
115
115
116
-
let get_u8 s i = Char.code (String.get s i)
116
+
let u8 s i = Char.code (String.get s i)
117
117
118
-
let get_u16_be s i =
119
-
let b0 = get_u8 s i in
120
-
let b1 = get_u8 s (i + 1) in
118
+
let u16_be s i =
119
+
let b0 = u8 s i in
120
+
let b1 = u8 s (i + 1) in
121
121
(b0 lsl 8) lor b1
122
122
123
-
let get_u32_be s i =
124
-
let b0 = get_u8 s i in
125
-
let b1 = get_u8 s (i + 1) in
126
-
let b2 = get_u8 s (i + 2) in
127
-
let b3 = get_u8 s (i + 3) in
123
+
let u32_be s i =
124
+
let b0 = u8 s i in
125
+
let b1 = u8 s (i + 1) in
126
+
let b2 = u8 s (i + 2) in
127
+
let b3 = u8 s (i + 3) in
128
128
(b0 lsl 24) lor (b1 lsl 16) lor (b2 lsl 8) lor b3
129
129
130
-
let get_var_uint_be s off len =
130
+
let var_uint_be s off len =
131
131
let rec aux acc i =
132
-
if i >= len then acc else aux ((acc lsl 8) lor get_u8 s (off + i)) (i + 1)
132
+
if i >= len then acc else aux ((acc lsl 8) lor u8 s (off + i)) (i + 1)
133
133
in
134
134
aux 0 0
135
135
···
206
206
let hdr_len = min_header_len + vcfc_len in
207
207
if len < hdr_len then Error (Truncated { need = hdr_len; have = len })
208
208
else
209
-
let b0 = get_u8 buf 0 in
209
+
let b0 = u8 buf 0 in
210
210
let tfvn = (b0 lsr 4) land 0xF in
211
211
if tfvn <> tfvn_uslp then Error (Invalid_version tfvn)
212
212
else
213
213
let scid_hi = b0 land 0xF in
214
-
let b1 = get_u8 buf 1 in
215
-
let b2 = get_u8 buf 2 in
214
+
let b1 = u8 buf 1 in
215
+
let b2 = u8 buf 2 in
216
216
let scid_mid = b1 in
217
217
let scid_lo = (b2 lsr 4) land 0xF in
218
218
let scid_val = (scid_hi lsl 12) lor (scid_mid lsl 4) lor scid_lo in
219
219
let src_or_dest = if (b2 lsr 3) land 1 = 0 then Source else Dest in
220
220
let vcid_hi = b2 land 0x7 in
221
-
let b3 = get_u8 buf 3 in
221
+
let b3 = u8 buf 3 in
222
222
let vcid_lo = (b3 lsr 5) land 0x7 in
223
223
let vcid_val = (vcid_hi lsl 3) lor vcid_lo in
224
224
if vcid_val > 63 then Error (Invalid_vcid vcid_val)
···
227
227
if map_id_val > 15 then Error (Invalid_map_id map_id_val)
228
228
else
229
229
let eofph = b3 land 1 = 1 in
230
-
let frame_len = get_u16_be buf 4 in
231
-
let b6 = get_u8 buf 6 in
230
+
let frame_len = u16_be buf 4 in
231
+
let b6 = u8 buf 6 in
232
232
let bypass_flag = (b6 lsr 7) land 1 = 1 in
233
233
let prot_ctrl_cmd = (b6 lsr 6) land 1 = 1 in
234
234
let ocf_flag = (b6 lsr 3) land 1 = 1 in
235
235
let vcfc_len_field = b6 land 0x7 in
236
-
let vcfc =
237
-
if vcfc_len > 0 then get_var_uint_be buf 7 vcfc_len else 0
238
-
in
236
+
let vcfc = if vcfc_len > 0 then var_uint_be buf 7 vcfc_len else 0 in
239
237
Ok
240
238
{
241
239
tfvn;
···
254
252
255
253
(* {1 Frame decoding} *)
256
254
255
+
let verify_fecf ~compute buf fecf_off fecf_val =
256
+
let expected = compute (String.sub buf 0 fecf_off) in
257
+
if expected <> fecf_val then
258
+
Error
259
+
(Fecf_mismatch
260
+
{ expected = Int64.of_int expected; actual = Int64.of_int fecf_val })
261
+
else Ok ()
262
+
263
+
let make_frame header insert_zone data ocf fecf =
264
+
Ok { header; insert_zone; data; ocf; fecf }
265
+
257
266
let decode ?(vcfc_len = 0) ?(insert_zone_len = 0) ?(expect_ocf = false)
258
267
?(expect_fecf = No_fecf) ?(check_fecf = true) buf =
259
268
let buf_len = String.length buf in
···
289
298
let data_off = hdr_len + insert_zone_len in
290
299
let data = String.sub buf data_off data_len in
291
300
let ocf_off = data_off + data_len in
292
-
let ocf =
293
-
if ocf_size > 0 then Some (get_u32_be buf ocf_off) else None
294
-
in
301
+
let ocf = if ocf_size > 0 then Some (u32_be buf ocf_off) else None in
295
302
let fecf_off = ocf_off + ocf_size in
296
303
match expect_fecf with
297
-
| No_fecf -> Ok { header; insert_zone; data; ocf; fecf = None }
304
+
| No_fecf -> make_frame header insert_zone data ocf None
298
305
| Crc16 ->
299
-
let fecf_val = get_u16_be buf fecf_off in
306
+
let fecf_val = u16_be buf fecf_off in
307
+
let fecf = Some (Int64.of_int fecf_val) in
300
308
if check_fecf then
301
-
let expected = compute_crc16 (String.sub buf 0 fecf_off) in
302
-
if expected <> fecf_val then
303
-
Error
304
-
(Fecf_mismatch
305
-
{
306
-
expected = Int64.of_int expected;
307
-
actual = Int64.of_int fecf_val;
308
-
})
309
-
else
310
-
Ok
311
-
{
312
-
header;
313
-
insert_zone;
314
-
data;
315
-
ocf;
316
-
fecf = Some (Int64.of_int fecf_val);
317
-
}
318
-
else
319
-
Ok
320
-
{
321
-
header;
322
-
insert_zone;
323
-
data;
324
-
ocf;
325
-
fecf = Some (Int64.of_int fecf_val);
326
-
}
309
+
match
310
+
verify_fecf ~compute:compute_crc16 buf fecf_off fecf_val
311
+
with
312
+
| Error e -> Error e
313
+
| Ok () -> make_frame header insert_zone data ocf fecf
314
+
else make_frame header insert_zone data ocf fecf
327
315
| Crc32 ->
328
-
let fecf_val = get_u32_be buf fecf_off in
316
+
let fecf_val = u32_be buf fecf_off in
317
+
let fecf = Some (Int64.of_int fecf_val) in
329
318
if check_fecf then
330
-
let expected = compute_crc32 (String.sub buf 0 fecf_off) in
331
-
if expected <> fecf_val then
332
-
Error
333
-
(Fecf_mismatch
334
-
{
335
-
expected = Int64.of_int expected;
336
-
actual = Int64.of_int fecf_val;
337
-
})
338
-
else
339
-
Ok
340
-
{
341
-
header;
342
-
insert_zone;
343
-
data;
344
-
ocf;
345
-
fecf = Some (Int64.of_int fecf_val);
346
-
}
347
-
else
348
-
Ok
349
-
{
350
-
header;
351
-
insert_zone;
352
-
data;
353
-
ocf;
354
-
fecf = Some (Int64.of_int fecf_val);
355
-
})
319
+
match
320
+
verify_fecf ~compute:compute_crc32 buf fecf_off fecf_val
321
+
with
322
+
| Error e -> Error e
323
+
| Ok () -> make_frame header insert_zone data ocf fecf
324
+
else make_frame header insert_zone data ocf fecf)
356
325
357
326
(* {1 Frame encoding} *)
358
327
···
649
618
650
619
(* {1 CLCW Integration} *)
651
620
652
-
let get_clcw frame =
621
+
let find_clcw frame =
653
622
match frame.ocf with None -> None | Some word -> Some (Clcw.decode word)
654
623
655
624
let set_clcw frame clcw =
+41
-4
lib/uslp.mli
+41
-4
lib/uslp.mli
···
31
31
(** Spacecraft Identifier (16 bits, 0-65535). *)
32
32
33
33
val scid : int -> scid option
34
+
34
35
val scid_exn : int -> scid
36
+
(** Like {!scid} but raises [Invalid_argument]. *)
37
+
35
38
val scid_to_int : scid -> int
39
+
(** Extract the underlying integer. *)
36
40
37
41
type vcid = private int
38
42
(** Virtual Channel Identifier (6 bits, 0-63). *)
39
43
40
44
val vcid : int -> vcid option
45
+
41
46
val vcid_exn : int -> vcid
47
+
(** Like {!vcid} but raises [Invalid_argument]. *)
48
+
42
49
val vcid_to_int : vcid -> int
50
+
(** Extract the underlying integer. *)
43
51
44
52
type map_id = private int
45
53
(** Multiplexer Access Point Identifier (4 bits, 0-15). *)
46
54
47
55
val map_id : int -> map_id option
56
+
48
57
val map_id_exn : int -> map_id
58
+
(** Like {!map_id} but raises [Invalid_argument]. *)
59
+
49
60
val map_id_to_int : map_id -> int
61
+
(** Extract the underlying integer. *)
50
62
51
63
(** {1 Types} *)
52
64
···
83
95
(** USLP Transfer Frame. *)
84
96
85
97
val equal_header : header -> header -> bool
98
+
86
99
val equal : t -> t -> bool
100
+
(** Structural equality for frames. *)
101
+
87
102
val pp_header : Format.formatter -> header -> unit
103
+
(** Pretty-print a USLP header. *)
104
+
88
105
val pp : Format.formatter -> t -> unit
106
+
(** Pretty-print a USLP frame. *)
107
+
89
108
val pp_src_or_dest : Format.formatter -> src_or_dest -> unit
109
+
(** Pretty-print a source/destination indicator. *)
90
110
91
111
(** {1 Errors} *)
92
112
···
100
120
| Invalid_vcfc_len of int
101
121
102
122
val pp_error : Format.formatter -> error -> unit
123
+
(** Pretty-print a decode error. *)
103
124
104
125
(** {1 Encoding/Decoding} *)
105
126
···
116
137
@param insert_zone_len Insert zone length (default: 0)
117
138
@param expect_ocf Whether OCF is present (default: false)
118
139
@param expect_fecf FECF type (default: No_fecf)
119
-
@param check_fecf Whether to verify FECF (default: true) *)
140
+
@param check_fecf Whether to verify FECF (default: true). *)
120
141
121
142
val encode :
122
143
?insert_zone_len:int -> ?with_ocf:bool -> ?fecf:fecf_type -> t -> string
123
144
(** [encode frame] encodes a USLP frame to a string.
124
145
@param insert_zone_len Insert zone length to reserve (default: 0)
125
146
@param with_ocf Whether to include OCF (default: false)
126
-
@param fecf FECF type (default: No_fecf) *)
147
+
@param fecf FECF type (default: No_fecf). *)
127
148
128
149
val encoded_len :
129
150
?insert_zone_len:int -> ?with_ocf:bool -> ?fecf:fecf_type -> t -> int
···
164
185
165
186
(** {1 CLCW Integration} *)
166
187
167
-
val get_clcw : t -> (Clcw.t, Clcw.error) result option
168
-
(** [get_clcw frame] extracts and decodes the CLCW from the OCF if present. *)
188
+
val find_clcw : t -> (Clcw.t, Clcw.error) result option
189
+
(** [find_clcw frame] extracts and decodes the CLCW from the OCF if present. *)
169
190
170
191
val set_clcw : t -> Clcw.t -> t
171
192
(** [set_clcw frame clcw] sets the OCF to the encoded CLCW. *)
···
212
233
val of_packed_header :
213
234
packed_header ->
214
235
(header, [ `Invalid_scid | `Invalid_vcid | `Invalid_map_id ]) result
236
+
(** Convert a packed header to a validated header. *)
215
237
216
238
val equal_packed_header : packed_header -> packed_header -> bool
239
+
(** Structural equality for packed headers. *)
217
240
218
241
(** {1 Wire Codec} *)
219
242
220
243
val codec : packed_header Wire.Codec.t
244
+
221
245
val struct_ : Wire.struct_
246
+
(** Wire struct definition for a USLP header. *)
247
+
222
248
val module_ : Wire.module_
249
+
(** Wire module definition for USLP. *)
223
250
224
251
(** {1 Wire Parse/Encode} *)
225
252
226
253
val wire_size : int
254
+
227
255
val decode_bytes : bytes -> (packed_header, Wire.parse_error) result
256
+
(** Decode a packed header from bytes. *)
257
+
228
258
val decode_string : string -> (packed_header, Wire.parse_error) result
259
+
(** Decode a packed header from a string. *)
260
+
229
261
val encode_string : packed_header -> string
262
+
(** Encode a packed header to a string. *)
263
+
230
264
val encode_bytes : packed_header -> bytes
265
+
(** Encode a packed header to bytes. *)
231
266
232
267
(** {1 FFI Code Generation} *)
233
268
234
269
val c_stubs : unit -> string
270
+
235
271
val ml_stubs : unit -> string
272
+
(** Generate OCaml FFI stub code. *)
+1
-1
test/dune
+1
-1
test/dune
+1
test/test.ml
+1
test/test.ml
···
1
+
let () = Alcotest.run "uslp" Test_uslp.suite
+24
-26
test/test_uslp.ml
+24
-26
test/test_uslp.ml
···
62
62
match Uslp.decode ~expect_ocf:true encoded with
63
63
| Error e -> Alcotest.failf "decode failed: %a" Uslp.pp_error e
64
64
| Ok frame' -> (
65
-
match Uslp.get_clcw frame' with
65
+
match Uslp.find_clcw frame' with
66
66
| None -> Alcotest.fail "no CLCW"
67
67
| Some (Error e) ->
68
68
Alcotest.failf "CLCW decode failed: %a" Clcw.pp_error e
···
171
171
let wire = Uslp.encode_string packed in
172
172
Alcotest.(check string) "wire=manual" manual wire
173
173
174
-
let () =
175
-
Alcotest.run "uslp"
176
-
[
177
-
( "uslp",
178
-
[
179
-
Alcotest.test_case "roundtrip" `Quick test_roundtrip;
180
-
Alcotest.test_case "roundtrip_with_vcfc" `Quick
181
-
test_roundtrip_with_vcfc;
182
-
Alcotest.test_case "roundtrip_with_crc16" `Quick
183
-
test_roundtrip_with_crc16;
184
-
Alcotest.test_case "roundtrip_with_crc32" `Quick
185
-
test_roundtrip_with_crc32;
186
-
Alcotest.test_case "clcw_integration" `Quick test_clcw_integration;
187
-
Alcotest.test_case "idle_frame" `Quick test_idle_frame;
188
-
Alcotest.test_case "src_dest" `Quick test_src_dest;
189
-
Alcotest.test_case "vcid_bounds" `Quick test_vcid_bounds;
190
-
Alcotest.test_case "scid_bounds" `Quick test_scid_bounds;
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;
197
-
] );
198
-
]
174
+
let suite =
175
+
[
176
+
( "uslp",
177
+
[
178
+
Alcotest.test_case "roundtrip" `Quick test_roundtrip;
179
+
Alcotest.test_case "roundtrip_with_vcfc" `Quick test_roundtrip_with_vcfc;
180
+
Alcotest.test_case "roundtrip_with_crc16" `Quick
181
+
test_roundtrip_with_crc16;
182
+
Alcotest.test_case "roundtrip_with_crc32" `Quick
183
+
test_roundtrip_with_crc32;
184
+
Alcotest.test_case "clcw_integration" `Quick test_clcw_integration;
185
+
Alcotest.test_case "idle_frame" `Quick test_idle_frame;
186
+
Alcotest.test_case "src_dest" `Quick test_src_dest;
187
+
Alcotest.test_case "vcid_bounds" `Quick test_vcid_bounds;
188
+
Alcotest.test_case "scid_bounds" `Quick test_scid_bounds;
189
+
Alcotest.test_case "map_id_bounds" `Quick test_map_id_bounds;
190
+
] );
191
+
( "wire",
192
+
[
193
+
Alcotest.test_case "wire_roundtrip" `Quick test_wire_roundtrip;
194
+
Alcotest.test_case "wire_vs_manual" `Quick test_wire_vs_manual;
195
+
] );
196
+
]
+1
test/test_uslp.mli
+1
test/test_uslp.mli
···
1
+
val suite : (string * unit Alcotest.test_case list) list