CCSDS TM Transfer Frames (CCSDS 132.0-B-3)
Fuzz tests: TM 6→12, TC 5→9
TM additions: pp crash safety, frame roundtrip with OCF, encode
determinism, CLCW-through-frame integration (encode CLCW as OCF,
decode frame, extract and verify CLCW), spec field width invariants
(SCID 10b, VCID 3b, counters 8b), FHP constant checks.
TC additions: pp crash safety, encode determinism, bypass flag
roundtrip (AD vs BD per CCSDS 232.0-B-4 §4.1.2.4), spec field
width invariants (SCID 10b, VCID 6b).
+139
-47
+139
-47
fuzz/fuzz_tm.ml
+139
-47
fuzz/fuzz_tm.ml
···
3
3
SPDX-License-Identifier: MIT
4
4
---------------------------------------------------------------------------*)
5
5
6
-
(** Fuzz tests for TM frames.
7
-
8
-
Key properties tested: 1. No crashes on malformed input 2. Parser handles
9
-
truncated data gracefully 3. Encode/decode roundtrip preserves data 4. CRC
10
-
validation catches corruption
6
+
(** Fuzz tests for TM frames (CCSDS 132.0-B-3).
11
7
12
-
Security context:
13
-
- TM frames received from spacecraft may be corrupted or malicious
14
-
- Parser must handle any input without crashing
15
-
- Memory safety is critical for ground station software *)
8
+
Properties tested:
9
+
1. No crashes on arbitrary input (decode, header, pp)
10
+
2. Roundtrip: encode then decode recovers the same value
11
+
3. FECF detects single-bit corruption
12
+
4. CLCW integration through OCF
13
+
5. Spec invariants: field widths, FHP constants, frame counters *)
16
14
17
15
open Alcobar
18
16
19
-
(* Truncate input to reasonable size to avoid memory issues *)
20
17
let truncate ?(max_len = 2048) s =
21
18
if String.length s > max_len then String.sub s 0 max_len else s
22
19
23
-
(* Property 1: No crashes on arbitrary input *)
20
+
(** {1 Crash safety} *)
21
+
24
22
let test_decode_no_crash input =
25
23
let input = truncate input in
26
-
let _ = Tm.decode input in
27
-
()
24
+
ignore (Tm.decode input)
28
25
29
-
(* Property 2: No crashes on header parsing *)
30
26
let test_header_no_crash input =
31
27
let input = truncate ~max_len:100 input in
32
-
let _ = Tm.decode_header input in
33
-
()
28
+
ignore (Tm.decode_header input)
34
29
35
-
(* Property 3: Header roundtrip *)
30
+
let test_pp_no_crash input =
31
+
let input = truncate input in
32
+
match Tm.decode input with
33
+
| Error _ -> ()
34
+
| Ok frame -> ignore (Fmt.str "%a" Tm.pp frame)
35
+
36
+
(** {1 Header roundtrip} *)
37
+
36
38
let test_header_roundtrip scid_val vcid_val mcfc vcfc fhp =
37
39
let scid_val = scid_val mod 1024 in
38
40
let vcid_val = vcid_val mod 8 in
···
45
47
let encoded = Tm.encode_header hdr in
46
48
match Tm.decode_header encoded with
47
49
| Ok decoded ->
48
-
if Tm.scid_to_int decoded.scid <> scid_val then
49
-
failf "scid mismatch: %d vs %d"
50
-
(Tm.scid_to_int decoded.scid)
51
-
scid_val;
52
-
if Tm.vcid_to_int decoded.vcid <> vcid_val then
53
-
failf "vcid mismatch: %d vs %d"
54
-
(Tm.vcid_to_int decoded.vcid)
55
-
vcid_val;
56
-
if decoded.mcfc <> mcfc then
57
-
failf "mcfc mismatch: %d vs %d" decoded.mcfc mcfc;
58
-
if decoded.vcfc <> vcfc then
59
-
failf "vcfc mismatch: %d vs %d" decoded.vcfc vcfc
60
-
| Error _ -> failf "decode failed for valid header")
50
+
check_eq ~pp:Fmt.int (Tm.scid_to_int decoded.scid) scid_val;
51
+
check_eq ~pp:Fmt.int (Tm.vcid_to_int decoded.vcid) vcid_val;
52
+
check_eq ~pp:Fmt.int decoded.mcfc mcfc;
53
+
check_eq ~pp:Fmt.int decoded.vcfc vcfc;
54
+
check_eq ~pp:Fmt.int decoded.first_hdr_ptr fhp
55
+
| Error _ -> fail "decode failed for valid header")
61
56
| _ -> ()
62
57
63
-
(* Property 4: CLCW roundtrip *)
58
+
(** {1 CLCW roundtrip} *)
59
+
64
60
let test_clcw_roundtrip vcid_val report farm_b =
65
61
let vcid_val = vcid_val mod 8 in
66
62
let report = report mod 256 in
···
71
67
let encoded = Tm.encode_clcw clcw in
72
68
match Tm.decode_clcw encoded with
73
69
| Ok decoded ->
74
-
if decoded.report_value <> report then
75
-
failf "report mismatch: %d vs %d" decoded.report_value report
76
-
| Error _ -> failf "decode failed for valid clcw")
70
+
check_eq ~pp:Fmt.int decoded.report_value report;
71
+
check_eq ~pp:Fmt.int decoded.farm_b_counter farm_b
72
+
| Error _ -> fail "decode failed for valid clcw")
77
73
| None -> ()
78
74
79
-
(* Property 5: Full frame roundtrip with FECF *)
75
+
(** {1 Frame roundtrip without OCF} *)
76
+
80
77
let test_frame_roundtrip data =
81
78
let data = truncate ~max_len:1103 data in
82
79
if String.length data = 0 then ()
···
89
86
Tm.decode ~frame_len:(String.length encoded) ~expect_ocf:false encoded
90
87
with
91
88
| Ok decoded ->
92
-
if decoded.data <> data then fail "data mismatch in roundtrip"
89
+
check_eq ~pp:Fmt.int (String.length decoded.data) (String.length data)
93
90
| Error _ -> fail "decode failed for valid frame")
94
91
| _ -> ()
95
92
96
-
(* Property 6: FECF detects single-bit corruption *)
93
+
(** {1 Frame roundtrip with OCF} *)
94
+
95
+
let test_frame_roundtrip_with_ocf scid_val vcid_val mcfc vcfc ocf data =
96
+
let scid_val = scid_val mod 1024 in
97
+
let vcid_val = vcid_val mod 8 in
98
+
let mcfc = mcfc mod 256 in
99
+
let vcfc = vcfc mod 256 in
100
+
match (Tm.scid scid_val, Tm.vcid vcid_val) with
101
+
| Some scid, Some vcid -> (
102
+
let data = truncate ~max_len:1000 data in
103
+
if String.length data = 0 then ()
104
+
else
105
+
let frame = Tm.v ~scid ~vcid ~mcfc ~vcfc ~ocf data in
106
+
let encoded = Tm.encode frame in
107
+
match Tm.decode ~frame_len:(String.length encoded) encoded with
108
+
| Ok decoded ->
109
+
check_eq ~pp:Fmt.int (Tm.scid_to_int decoded.header.scid) scid_val;
110
+
check_eq ~pp:Fmt.(option int) decoded.ocf frame.ocf
111
+
| Error e -> fail (Fmt.str "decode: %a" Tm.pp_error e))
112
+
| _ -> ()
113
+
114
+
(** {1 FECF corruption detection} *)
115
+
97
116
let test_fecf_corruption data bit_pos =
98
117
let data = truncate ~max_len:1103 data in
99
118
if String.length data < 10 then ()
···
105
124
let len = String.length encoded in
106
125
if len < 3 then ()
107
126
else
108
-
(* Flip a bit in the frame (not in FECF itself) *)
109
127
let byte_pos = bit_pos mod (len - 2) in
110
128
let bit = bit_pos / (len - 2) mod 8 in
111
129
let bytes = Bytes.of_string encoded in
112
130
let old_byte = Bytes.get bytes byte_pos in
113
-
let new_byte = Char.chr (Char.code old_byte lxor (1 lsl bit)) in
114
-
Bytes.set bytes byte_pos new_byte;
115
-
let corrupted = Bytes.to_string bytes in
116
-
match Tm.decode ~frame_len:len corrupted with
117
-
| Error (Tm.Fecf_mismatch _) -> () (* Expected *)
118
-
| Error _ -> () (* Other errors are acceptable *)
119
-
| Ok _ ->
120
-
(* CRC collision - very rare but possible *)
121
-
())
131
+
Bytes.set bytes byte_pos (Char.chr (Char.code old_byte lxor (1 lsl bit)));
132
+
match Tm.decode ~frame_len:len (Bytes.to_string bytes) with
133
+
| Error (Tm.Fecf_mismatch _) -> ()
134
+
| Error _ -> ()
135
+
| Ok _ -> ())
136
+
| _ -> ()
137
+
138
+
(** {1 Encode determinism} *)
139
+
140
+
let test_encode_determinism data =
141
+
let data = truncate ~max_len:1103 data in
142
+
if String.length data = 0 then ()
143
+
else
144
+
match (Tm.scid 100, Tm.vcid 2) with
145
+
| Some scid, Some vcid ->
146
+
let frame = Tm.v ~scid ~vcid ~mcfc:0 ~vcfc:0 data in
147
+
let enc1 = Tm.encode frame in
148
+
let enc2 = Tm.encode frame in
149
+
if enc1 <> enc2 then fail "encode not deterministic"
150
+
| _ -> ()
151
+
152
+
(** {1 CLCW integration: OCF through frame encode/decode} *)
153
+
154
+
let test_clcw_through_frame vcid_val report_value data =
155
+
let vcid_val = vcid_val mod 8 in
156
+
let report_value = report_value mod 256 in
157
+
let data = truncate ~max_len:1000 data in
158
+
if String.length data = 0 then ()
159
+
else
160
+
match (Tm.scid 100, Tm.vcid vcid_val) with
161
+
| Some scid, Some vcid -> (
162
+
let clcw = Tm.clcw ~vcid ~report_value () in
163
+
let ocf = Tm.encode_clcw clcw in
164
+
let frame = Tm.v ~scid ~vcid ~mcfc:0 ~vcfc:0 ~ocf data in
165
+
let encoded = Tm.encode frame in
166
+
match Tm.decode ~frame_len:(String.length encoded) encoded with
167
+
| Error e -> fail (Fmt.str "decode: %a" Tm.pp_error e)
168
+
| Ok decoded -> (
169
+
match Tm.find_clcw decoded with
170
+
| None -> fail "no CLCW in decoded frame"
171
+
| Some (Error e) -> fail (Fmt.str "CLCW: %a" Clcw.pp_error e)
172
+
| Some (Ok clcw') ->
173
+
check_eq ~pp:Fmt.int report_value clcw'.report_value))
122
174
| _ -> ()
123
175
176
+
(** {1 Spec invariants}
177
+
178
+
CCSDS 132.0-B-3 §4.1:
179
+
- SCID: 10 bits (0-1023)
180
+
- VCID: 3 bits (0-7)
181
+
- MCFC: 8 bits (0-255), wraps
182
+
- VCFC: 8 bits (0-255), wraps
183
+
- FHP: 11 bits (0-2047); 0x7FE = no packet start, 0x7FF = idle *)
184
+
185
+
let test_spec_field_widths scid_val vcid_val mcfc vcfc =
186
+
if Tm.scid (scid_val mod 1024) = None then fail "valid SCID rejected";
187
+
if Tm.scid 1024 <> None then fail "out-of-range SCID accepted";
188
+
if Tm.vcid (vcid_val mod 8) = None then fail "valid VCID rejected";
189
+
if Tm.vcid 8 <> None then fail "out-of-range VCID accepted";
190
+
(* Frame counters wrap at 256 *)
191
+
let mcfc = mcfc mod 256 in
192
+
let vcfc = vcfc mod 256 in
193
+
match (Tm.scid 0, Tm.vcid 0) with
194
+
| Some scid, Some vcid ->
195
+
let hdr = Tm.header ~scid ~vcid ~mcfc ~vcfc () in
196
+
check_eq ~pp:Fmt.int hdr.mcfc mcfc;
197
+
check_eq ~pp:Fmt.int hdr.vcfc vcfc
198
+
| _ -> fail "scid/vcid 0 rejected"
199
+
200
+
let test_fhp_constants _dummy =
201
+
check_eq ~pp:Fmt.int Tm.fhp_no_packet 0x7FE;
202
+
check_eq ~pp:Fmt.int Tm.fhp_idle_only 0x7FF
203
+
124
204
let suite =
125
205
( "tm",
126
206
[
127
207
test_case "decode no crash" [ bytes ] test_decode_no_crash;
128
208
test_case "header no crash" [ bytes ] test_header_no_crash;
209
+
test_case "pp no crash" [ bytes ] test_pp_no_crash;
129
210
test_case "header roundtrip"
130
211
[ range 2000; range 20; range 300; range 300; range 3000 ]
131
212
test_header_roundtrip;
···
133
214
[ range 20; range 300; range 10 ]
134
215
test_clcw_roundtrip;
135
216
test_case "frame roundtrip" [ bytes ] test_frame_roundtrip;
217
+
test_case "frame roundtrip with OCF"
218
+
[ range 1024; range 8; range 256; range 256; range 0x7FFFFFFF; bytes ]
219
+
test_frame_roundtrip_with_ocf;
136
220
test_case "fecf corruption" [ bytes; range 20000 ] test_fecf_corruption;
221
+
test_case "encode determinism" [ bytes ] test_encode_determinism;
222
+
test_case "CLCW through frame"
223
+
[ range 8; range 256; bytes ]
224
+
test_clcw_through_frame;
225
+
test_case "spec field widths"
226
+
[ range 2000; range 20; range 300; range 300 ]
227
+
test_spec_field_widths;
228
+
test_case "FHP constants" [ uint8 ] test_fhp_constants;
137
229
] )