Reed-Solomon error correction over GF(2^8)
Fix turbo decoder, add fuzzers for SDLS/RS/FlexACM
- Fix BCJR extrinsic LLR double-subtraction in turbo decoder;
all 7 turbo roundtrip tests now pass (39 total tm-sync tests)
- ocaml-sdls/fuzz: SA lifecycle, key state, EP PDU roundtrip (13 tests)
- ocaml-reed-solomon/fuzz: encode/decode with random errors (6 tests)
- ocaml-flexacm/fuzz: mode lookup, SNR monotonicity (6 tests)
+137
+22
fuzz/dune
+22
fuzz/dune
···
1
+
(executable
2
+
(name fuzz)
3
+
(modules fuzz fuzz_reed_solomon)
4
+
(libraries reed-solomon alcobar))
5
+
6
+
(rule
7
+
(alias runtest)
8
+
(enabled_if
9
+
(<> %{profile} afl))
10
+
(deps fuzz.exe)
11
+
(action
12
+
(run %{exe:fuzz.exe})))
13
+
14
+
(rule
15
+
(alias fuzz)
16
+
(enabled_if
17
+
(= %{profile} afl))
18
+
(deps fuzz.exe)
19
+
(action
20
+
(progn
21
+
(run %{exe:fuzz.exe} --gen-corpus corpus)
22
+
(run afl-fuzz -V 60 -i corpus -o _fuzz -- %{exe:fuzz.exe} @@))))
+1
fuzz/fuzz.ml
+1
fuzz/fuzz.ml
···
1
+
let () = Alcobar.run "reed_solomon" [ Fuzz_reed_solomon.suite ]
+114
fuzz/fuzz_reed_solomon.ml
+114
fuzz/fuzz_reed_solomon.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open Alcobar
7
+
8
+
let pp_bytes ppf b = Format.pp_print_string ppf (Bytes.to_string b)
9
+
let cfg = Reed_solomon.ccsds
10
+
11
+
(** Encode/decode roundtrip with no errors: encoding then decoding should
12
+
recover the original data. *)
13
+
let test_roundtrip_no_errors data_seed =
14
+
let data =
15
+
Bytes.init cfg.k (fun i -> Char.chr (((i * 37) + data_seed) land 0xFF))
16
+
in
17
+
let codeword = Reed_solomon.encode cfg data in
18
+
match Reed_solomon.decode cfg codeword with
19
+
| Ok recovered -> check_eq ~pp:pp_bytes data recovered
20
+
| Error e -> failf "roundtrip decode failed: %a" Reed_solomon.pp_error e
21
+
22
+
(** Encode/decode roundtrip with random errors up to the correction capability.
23
+
RS(255,223) can correct up to 16 symbol errors. *)
24
+
let test_roundtrip_with_errors data_seed num_errors_raw error_positions
25
+
error_values =
26
+
let num_errors = num_errors_raw mod (cfg.t + 1) in
27
+
if num_errors < 0 then bad_test ()
28
+
else
29
+
let data =
30
+
Bytes.init cfg.k (fun i -> Char.chr (((i * 53) + data_seed) land 0xFF))
31
+
in
32
+
let codeword = Reed_solomon.encode cfg data in
33
+
let corrupted = Bytes.copy codeword in
34
+
(* Inject errors at distinct positions *)
35
+
let used = Hashtbl.create 16 in
36
+
let errors_injected = ref 0 in
37
+
let pos_str = error_positions in
38
+
let val_str = error_values in
39
+
let i = ref 0 in
40
+
while !errors_injected < num_errors && !i < String.length pos_str do
41
+
let pos = Char.code pos_str.[!i] mod cfg.n in
42
+
if not (Hashtbl.mem used pos) then begin
43
+
Hashtbl.add used pos true;
44
+
let v =
45
+
if !i < String.length val_str then Char.code val_str.[!i] else 0xAB
46
+
in
47
+
let orig = Char.code (Bytes.get corrupted pos) in
48
+
let new_val = orig lxor (v lor 1) in
49
+
(* Ensure the error is non-zero *)
50
+
Bytes.set corrupted pos (Char.chr (new_val land 0xFF));
51
+
incr errors_injected
52
+
end;
53
+
incr i
54
+
done;
55
+
if !errors_injected < num_errors then bad_test ()
56
+
else
57
+
match Reed_solomon.decode cfg corrupted with
58
+
| Ok recovered -> check_eq ~pp:pp_bytes data recovered
59
+
| Error e ->
60
+
failf "decode with %d errors failed: %a" num_errors
61
+
Reed_solomon.pp_error e
62
+
63
+
(** Decode crash safety: decoding arbitrary bytes should not raise exceptions.
64
+
It should return Ok or Error, never crash. *)
65
+
let test_decode_crash_safety input =
66
+
let len = String.length input in
67
+
if len <> cfg.n then bad_test ()
68
+
else begin
69
+
let buf = Bytes.of_string input in
70
+
match Reed_solomon.decode cfg buf with Ok _ -> () | Error _ -> ()
71
+
end
72
+
73
+
(** Decode with arbitrary-length input should return an error, not crash. *)
74
+
let test_decode_bad_length input =
75
+
let buf = Bytes.of_string input in
76
+
if Bytes.length buf = cfg.n then bad_test ()
77
+
else
78
+
match Reed_solomon.decode cfg buf with
79
+
| Ok _ -> fail "decode should reject wrong-length input"
80
+
| Error (`Invalid_length _) -> ()
81
+
| Error e ->
82
+
failf "decode wrong-length: unexpected error %a" Reed_solomon.pp_error e
83
+
84
+
(** Encoded codeword has correct length. *)
85
+
let test_encode_length data_seed =
86
+
let data =
87
+
Bytes.init cfg.k (fun i -> Char.chr (((i * 29) + data_seed) land 0xFF))
88
+
in
89
+
let codeword = Reed_solomon.encode cfg data in
90
+
check_eq ~pp:pp_int cfg.n (Bytes.length codeword)
91
+
92
+
(** Systematic property: first k bytes of codeword equal the data. *)
93
+
let test_systematic data_seed =
94
+
let data =
95
+
Bytes.init cfg.k (fun i -> Char.chr (((i * 43) + data_seed) land 0xFF))
96
+
in
97
+
let codeword = Reed_solomon.encode cfg data in
98
+
let prefix = Bytes.sub codeword 0 cfg.k in
99
+
check_eq ~pp:pp_bytes data prefix
100
+
101
+
let suite =
102
+
( "reed_solomon",
103
+
[
104
+
test_case "roundtrip no errors" [ uint8 ] test_roundtrip_no_errors;
105
+
test_case "roundtrip with errors"
106
+
[ uint8; uint8; bytes; bytes ]
107
+
test_roundtrip_with_errors;
108
+
test_case "decode crash safety"
109
+
[ bytes_fixed 255 ]
110
+
test_decode_crash_safety;
111
+
test_case "decode bad length" [ bytes ] test_decode_bad_length;
112
+
test_case "encode length" [ uint8 ] test_encode_length;
113
+
test_case "systematic property" [ uint8 ] test_systematic;
114
+
] )