CCSDS Command Link Control Word (CLCW) for spacecraft command
fix(clcw,openamp,merlint): remove fuzz special cases from E715
- clcw: fold fuzz_diff.ml into main fuzz runner, remove diff/ subdir
- openamp: inline fuzz_common.with_mock into fuzz_openamp.ml, delete
fuzz_common.ml
- E715: remove hardcoded fuzz_common exception
+11
-169
-17
fuzz/diff/dune
-17
fuzz/diff/dune
···
1
-
; Differential fuzz test: original vs wire OCaml implementations
2
-
3
-
(executable
4
-
(name fuzz)
5
-
(libraries clcw crowbar fmt))
6
-
7
-
(rule
8
-
(alias runtest)
9
-
(deps fuzz.exe)
10
-
(action
11
-
(run %{exe:fuzz.exe})))
12
-
13
-
(rule
14
-
(alias fuzz-afl)
15
-
(deps fuzz.exe)
16
-
(action
17
-
(echo "AFL fuzzer built: %{exe:fuzz.exe}\n")))
-142
fuzz/diff/fuzz.ml
-142
fuzz/diff/fuzz.ml
···
1
-
(** Differential fuzz testing: Original CLCW vs Wire vs C implementations.
2
-
3
-
Tests that all three implementations produce identical results for:
4
-
- Parsing: bytes -> value
5
-
- Encoding: value -> bytes
6
-
- Roundtrip: bytes -> value -> bytes *)
7
-
8
-
module Cr = Crowbar
9
-
10
-
(** {1 Helper Functions} *)
11
-
12
-
let pad_to_4 buf =
13
-
let len = String.length buf in
14
-
if len >= 4 then String.sub buf 0 4
15
-
else
16
-
let b = Bytes.make 4 '\000' in
17
-
Bytes.blit_string buf 0 b 0 len;
18
-
Bytes.to_string b
19
-
20
-
let bytes_to_int32_be s =
21
-
if String.length s < 4 then None
22
-
else
23
-
let b0 = Char.code s.[0] in
24
-
let b1 = Char.code s.[1] in
25
-
let b2 = Char.code s.[2] in
26
-
let b3 = Char.code s.[3] in
27
-
Some ((b0 lsl 24) lor (b1 lsl 16) lor (b2 lsl 8) lor b3)
28
-
29
-
(** Mask to clear reserved bits (CCSDS bits 14-15 and 23, which are positions
30
-
16-17 and 8 in int32). Per CCSDS spec, reserved bits should be 0, so
31
-
roundtrip is only expected to preserve non-reserved bits. *)
32
-
let reserved_mask = lnot 0x30100
33
-
34
-
let mask_reserved_bytes buf =
35
-
if String.length buf < 4 then buf
36
-
else
37
-
match bytes_to_int32_be buf with
38
-
| None -> buf
39
-
| Some word ->
40
-
let masked = word land reserved_mask in
41
-
let b = Bytes.create 4 in
42
-
Bytes.set_int32_be b 0 (Int32.of_int masked);
43
-
Bytes.to_string b
44
-
45
-
(** {1 Original CLCW Helpers} *)
46
-
47
-
let original_decode buf =
48
-
match bytes_to_int32_be buf with
49
-
| None -> None
50
-
| Some word -> (
51
-
match Clcw.decode word with Ok t -> Some t | Error _ -> None)
52
-
53
-
let original_encode (t : Clcw.t) =
54
-
let word = Clcw.encode t in
55
-
let b = Bytes.create 4 in
56
-
Bytes.set_int32_be b 0 (Int32.of_int word);
57
-
Bytes.to_string b
58
-
59
-
(** {1 Wire CLCW Helpers} *)
60
-
61
-
let wire_decode buf =
62
-
match Clcw.decode_string buf with Ok t -> Some t | Error _ -> None
63
-
64
-
let wire_encode (t : Clcw.packed) = Clcw.encode_string t
65
-
66
-
(** {1 Comparison} *)
67
-
68
-
let clcw_equal (orig : Clcw.t) (wire : Clcw.packed) =
69
-
orig.control_word_type = wire.control_word_type
70
-
&& orig.version = wire.version
71
-
&& Clcw.equal_status orig.status wire.status
72
-
&& orig.cop_in_effect = wire.cop_in_effect
73
-
&& Clcw.vcid_to_int orig.vcid = wire.vcid
74
-
&& orig.flags.no_rf_available = wire.no_rf_available
75
-
&& orig.flags.no_bit_lock = wire.no_bit_lock
76
-
&& orig.flags.lockout = wire.lockout
77
-
&& orig.flags.wait = wire.wait
78
-
&& orig.flags.retransmit = wire.retransmit
79
-
&& orig.farm_b_counter = wire.farm_b_counter
80
-
&& orig.report_value = wire.report_value
81
-
82
-
(** {1 Fuzz Tests} *)
83
-
84
-
let test_decode buf =
85
-
let buf = pad_to_4 buf in
86
-
let orig = original_decode buf in
87
-
let wire = wire_decode buf in
88
-
match (orig, wire) with
89
-
| None, None -> ()
90
-
| Some o, Some d ->
91
-
if not (clcw_equal o d) then
92
-
Cr.fail (Fmt.str "values differ for input %s" (String.escaped buf))
93
-
| Some _, None -> Cr.fail "original decoded but wire failed"
94
-
| None, Some _ -> Cr.fail "wire decoded but original failed"
95
-
96
-
let test_encode buf =
97
-
let buf = pad_to_4 buf in
98
-
match (original_decode buf, wire_decode buf) with
99
-
| Some orig, Some wire ->
100
-
let orig_bytes = original_encode orig in
101
-
let wire_bytes = wire_encode wire in
102
-
if orig_bytes <> wire_bytes then
103
-
Cr.fail
104
-
(Fmt.str "encoded bytes differ: orig=%s wire=%s"
105
-
(String.escaped orig_bytes)
106
-
(String.escaped wire_bytes))
107
-
| _ -> ()
108
-
109
-
let test_roundtrip_orig buf =
110
-
let buf = pad_to_4 buf in
111
-
let expected = mask_reserved_bytes buf in
112
-
match original_decode buf with
113
-
| None -> ()
114
-
| Some t ->
115
-
let encoded = original_encode t in
116
-
if encoded <> expected then
117
-
Cr.fail
118
-
(Fmt.str "roundtrip changed bytes: in=%s out=%s"
119
-
(String.escaped expected) (String.escaped encoded))
120
-
121
-
let test_roundtrip_wire buf =
122
-
let buf = pad_to_4 buf in
123
-
let expected = mask_reserved_bytes buf in
124
-
match wire_decode buf with
125
-
| None -> ()
126
-
| Some t ->
127
-
let encoded = wire_encode t in
128
-
if encoded <> expected then
129
-
Cr.fail
130
-
(Fmt.str "roundtrip changed bytes: in=%s out=%s"
131
-
(String.escaped expected) (String.escaped encoded))
132
-
133
-
let suite =
134
-
( "diff",
135
-
[
136
-
Cr.test_case "decode original vs wire" [ Cr.bytes ] test_decode;
137
-
Cr.test_case "encode original vs wire" [ Cr.bytes ] test_encode;
138
-
Cr.test_case "roundtrip original" [ Cr.bytes ] test_roundtrip_orig;
139
-
Cr.test_case "roundtrip wire" [ Cr.bytes ] test_roundtrip_wire;
140
-
] )
141
-
142
-
let () = Cr.run "diff" [ suite ]
+6
-6
fuzz/dune
+6
-6
fuzz/dune
···
1
1
(executable
2
-
(name fuzz_clcw)
3
-
(modules fuzz_clcw)
2
+
(name fuzz)
3
+
(modules fuzz fuzz_clcw fuzz_diff)
4
4
(libraries clcw crowbar))
5
5
6
6
(executable
···
12
12
(alias runtest)
13
13
(enabled_if
14
14
(<> %{profile} afl))
15
-
(deps fuzz_clcw.exe)
15
+
(deps fuzz.exe)
16
16
(action
17
-
(run %{exe:fuzz_clcw.exe})))
17
+
(run %{exe:fuzz.exe})))
18
18
19
19
(rule
20
20
(alias fuzz)
···
22
22
(= %{profile} afl))
23
23
(deps
24
24
(source_tree corpus)
25
-
fuzz_clcw.exe
25
+
fuzz.exe
26
26
gen_corpus.exe)
27
27
(action
28
-
(echo "AFL fuzzer built: %{exe:fuzz_clcw.exe}\n")))
28
+
(echo "AFL fuzzer built: %{exe:fuzz.exe}\n")))
+1
fuzz/fuzz.ml
+1
fuzz/fuzz.ml
···
1
+
let () = Crowbar.run "clcw" [ Fuzz_clcw.suite; Fuzz_diff.suite ]
+1
-1
fuzz/fuzz_clcw.ml
+1
-1
fuzz/fuzz_clcw.ml
+3
-3
fuzz/fuzz_diff.ml
+3
-3
fuzz/fuzz_diff.ml
···
81
81
82
82
(** {1 Fuzz Tests} *)
83
83
84
-
let () =
85
-
Cr.run "diff"
84
+
let suite =
85
+
( "diff",
86
86
[
87
87
(* Test: decode produces same result *)
88
88
Cr.test_case "decode original vs wire" [ Cr.bytes ] (fun buf ->
···
135
135
Cr.fail
136
136
(Fmt.str "roundtrip changed bytes: in=%s out=%s"
137
137
(String.escaped expected) (String.escaped encoded)));
138
-
]
138
+
] )