CCSDS Command Link Control Word (CLCW) for spacecraft command
fix(ocaml-atp,ocaml-clcw,ocaml-retry): pass all merlint checks
ocaml-atp: add test_naming.ml for hermest/lib/naming.ml (E605)
ocaml-clcw: merge fuzz_diff.ml into fuzz_clcw.ml to fix E710
(fuzz_diff had no corresponding library module)
ocaml-retry: extract test_retry.ml module with suite tuple (E605)
+108
-136
+1
-1
fuzz/dune
+1
-1
fuzz/dune
+1
-1
fuzz/fuzz.ml
+1
-1
fuzz/fuzz.ml
+106
fuzz/fuzz_clcw.ml
+106
fuzz/fuzz_clcw.ml
···
25
25
| Error e -> fail (Fmt.str "decode failed: %a" Clcw.pp_error e)
26
26
| Ok t' -> check_eq ~pp:Clcw.pp ~eq:Clcw.equal t t')
27
27
28
+
(** {1 Differential Tests} *)
29
+
30
+
let pad_to_4 buf =
31
+
let len = String.length buf in
32
+
if len >= 4 then String.sub buf 0 4
33
+
else
34
+
let b = Bytes.make 4 '\000' in
35
+
Bytes.blit_string buf 0 b 0 len;
36
+
Bytes.to_string b
37
+
38
+
let bytes_to_int32_be s =
39
+
if String.length s < 4 then None
40
+
else
41
+
let b0 = Char.code s.[0] in
42
+
let b1 = Char.code s.[1] in
43
+
let b2 = Char.code s.[2] in
44
+
let b3 = Char.code s.[3] in
45
+
Some ((b0 lsl 24) lor (b1 lsl 16) lor (b2 lsl 8) lor b3)
46
+
47
+
let reserved_mask = lnot 0x30100
48
+
49
+
let mask_reserved_bytes buf =
50
+
if String.length buf < 4 then buf
51
+
else
52
+
match bytes_to_int32_be buf with
53
+
| None -> buf
54
+
| Some word ->
55
+
let masked = word land reserved_mask in
56
+
let b = Bytes.create 4 in
57
+
Bytes.set_int32_be b 0 (Int32.of_int masked);
58
+
Bytes.to_string b
59
+
60
+
let original_decode buf =
61
+
match bytes_to_int32_be buf with
62
+
| None -> None
63
+
| Some word -> (
64
+
match Clcw.decode word with Ok t -> Some t | Error _ -> None)
65
+
66
+
let original_encode (t : Clcw.t) =
67
+
let word = Clcw.encode t in
68
+
let b = Bytes.create 4 in
69
+
Bytes.set_int32_be b 0 (Int32.of_int word);
70
+
Bytes.to_string b
71
+
72
+
let wire_decode buf =
73
+
match Clcw.decode_string buf with Ok t -> Some t | Error _ -> None
74
+
75
+
let wire_encode (t : Clcw.packed) = Clcw.encode_string t
76
+
77
+
let clcw_equal (orig : Clcw.t) (wire : Clcw.packed) =
78
+
orig.control_word_type = wire.control_word_type
79
+
&& orig.version = wire.version
80
+
&& Clcw.equal_status orig.status wire.status
81
+
&& orig.cop_in_effect = wire.cop_in_effect
82
+
&& Clcw.vcid_to_int orig.vcid = wire.vcid
83
+
&& orig.flags.no_rf_available = wire.no_rf_available
84
+
&& orig.flags.no_bit_lock = wire.no_bit_lock
85
+
&& orig.flags.lockout = wire.lockout
86
+
&& orig.flags.wait = wire.wait
87
+
&& orig.flags.retransmit = wire.retransmit
88
+
&& orig.farm_b_counter = wire.farm_b_counter
89
+
&& orig.report_value = wire.report_value
90
+
91
+
let test_diff_decode buf =
92
+
let buf = pad_to_4 buf in
93
+
let orig = original_decode buf in
94
+
let wire = wire_decode buf in
95
+
match (orig, wire) with
96
+
| None, None -> ()
97
+
| Some o, Some d ->
98
+
if not (clcw_equal o d) then
99
+
fail (Fmt.str "values differ for input %s" (String.escaped buf))
100
+
| Some _, None -> fail "original decoded but wire failed"
101
+
| None, Some _ -> fail "wire decoded but original failed"
102
+
103
+
let test_diff_encode buf =
104
+
let buf = pad_to_4 buf in
105
+
match (original_decode buf, wire_decode buf) with
106
+
| Some orig, Some wire ->
107
+
let orig_bytes = original_encode orig in
108
+
let wire_bytes = wire_encode wire in
109
+
if orig_bytes <> wire_bytes then
110
+
fail
111
+
(Fmt.str "encoded bytes differ: orig=%s wire=%s"
112
+
(String.escaped orig_bytes)
113
+
(String.escaped wire_bytes))
114
+
| _ -> ()
115
+
116
+
let test_diff_roundtrip decode encode buf =
117
+
let buf = pad_to_4 buf in
118
+
let expected = mask_reserved_bytes buf in
119
+
match decode buf with
120
+
| None -> ()
121
+
| Some t ->
122
+
let encoded = encode t in
123
+
if encoded <> expected then
124
+
fail
125
+
(Fmt.str "roundtrip changed bytes: in=%s out=%s"
126
+
(String.escaped expected) (String.escaped encoded))
127
+
28
128
let suite =
29
129
( "clcw",
30
130
[
31
131
test_case "roundtrip" [ int32 ] test_roundtrip;
32
132
test_case "encode-decode" [ range 64; range 256 ] test_encode_decode;
133
+
test_case "diff decode" [ bytes ] test_diff_decode;
134
+
test_case "diff encode" [ bytes ] test_diff_encode;
135
+
test_case "diff roundtrip original" [ bytes ]
136
+
(test_diff_roundtrip original_decode original_encode);
137
+
test_case "diff roundtrip wire" [ bytes ]
138
+
(test_diff_roundtrip wire_decode wire_encode);
33
139
] )
-130
fuzz/fuzz_diff.ml
-130
fuzz/fuzz_diff.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 decode encode buf =
110
-
let buf = pad_to_4 buf in
111
-
let expected = mask_reserved_bytes buf in
112
-
match decode buf with
113
-
| None -> ()
114
-
| Some t ->
115
-
let encoded = 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 suite =
122
-
( "diff",
123
-
[
124
-
Cr.test_case "decode original vs wire" [ Cr.bytes ] test_decode;
125
-
Cr.test_case "encode original vs wire" [ Cr.bytes ] test_encode;
126
-
Cr.test_case "roundtrip original" [ Cr.bytes ]
127
-
(test_roundtrip original_decode original_encode);
128
-
Cr.test_case "roundtrip wire" [ Cr.bytes ]
129
-
(test_roundtrip wire_decode wire_encode);
130
-
] )