gazagnaire.org
OCaml wire format DSL with EverParse 3D output for verified parsers
1(** Fuzz tests for schema roundtrips.
2
3 These tests verify that our OCaml encoder/decoder round-trips correctly.
4 When EverParse C integration is available, we can add differential tests. *)
5
6module Cr = Crowbar
7open Wire
8
9let truncate buf =
10 let max_len = 256 in
11 if String.length buf > max_len then String.sub buf 0 max_len else buf
12
13(* Helper: encode record to string using Codec API *)
14let encode_record_to_string codec v =
15 let ws = Codec.wire_size codec in
16 let buf = Bytes.create ws in
17 Codec.encode codec v buf 0;
18 Ok (Bytes.unsafe_to_string buf)
19
20(* Helper: decode record from string using Codec API *)
21let decode_record_from_string codec s =
22 let ws = Codec.wire_size codec in
23 if String.length s < ws then
24 Error (Unexpected_eof { expected = ws; got = String.length s })
25 else Ok (Codec.decode codec (Bytes.of_string s) 0)
26
27(** Test SimpleHeader roundtrip *)
28let test_simple_header_roundtrip version length flags =
29 let version = abs version mod 256 in
30 let length = abs length mod 65536 in
31 let flags = abs flags mod 256 in
32 let original = Schema.{ version; length; flags } in
33 match encode_record_to_string Schema.simple_header_codec original with
34 | Error _ -> Cr.fail "encode failed"
35 | Ok encoded -> (
36 match decode_record_from_string Schema.simple_header_codec encoded with
37 | Ok decoded ->
38 if original.version <> decoded.version then Cr.fail "version mismatch";
39 if original.length <> decoded.length then Cr.fail "length mismatch";
40 if original.flags <> decoded.flags then Cr.fail "flags mismatch"
41 | Error _ -> Cr.fail "decode failed")
42
43(** Test SimpleHeader decode crash safety *)
44let test_simple_header_crash buf =
45 let buf = truncate buf in
46 let _ = decode_record_from_string Schema.simple_header_codec buf in
47 ()
48
49(** Test ConstrainedPacket roundtrip with valid values *)
50let test_constrained_packet_roundtrip pkt_type pkt_length =
51 let pkt_type = abs pkt_type mod 4 in
52 let pkt_length = abs pkt_length mod 1025 in
53 let original = Schema.{ pkt_type; pkt_length } in
54 match encode_record_to_string Schema.constrained_packet_codec original with
55 | Error _ -> Cr.fail "encode failed"
56 | Ok encoded -> (
57 match
58 decode_record_from_string Schema.constrained_packet_codec encoded
59 with
60 | Ok decoded ->
61 if original.pkt_type <> decoded.pkt_type then
62 Cr.fail "pkt_type mismatch";
63 if original.pkt_length <> decoded.pkt_length then
64 Cr.fail "pkt_length mismatch"
65 | Error _ -> Cr.fail "decode failed")
66
67(** Test ConstrainedPacket decode crash safety *)
68let test_constrained_packet_crash buf =
69 let buf = truncate buf in
70 let _ = decode_record_from_string Schema.constrained_packet_codec buf in
71 ()
72
73let () =
74 Cr.run "schema"
75 [
76 ( "schema",
77 [
78 Cr.test_case "simple_header roundtrip" [ Cr.int; Cr.int; Cr.int ]
79 test_simple_header_roundtrip;
80 Cr.test_case "simple_header crash" [ Cr.bytes ]
81 test_simple_header_crash;
82 Cr.test_case "constrained_packet roundtrip" [ Cr.int; Cr.int ]
83 test_constrained_packet_roundtrip;
84 Cr.test_case "constrained_packet crash" [ Cr.bytes ]
85 test_constrained_packet_crash;
86 ] );
87 ]