forked from
anil.recoil.org/ocaml-yamlrw
Pure OCaml Yaml 1.2 reader and writer using Bytesrw
fix(E705): extract fuzz helpers library, drop fuzz_afl (ocaml-yamlrw)
+36
-125
+1
-7
fuzz/dune
+1
-7
fuzz/dune
···
1
1
(executable
2
2
(name fuzz)
3
-
(libraries crowbar yamlrw)
3
+
(libraries crowbar yamlrw fuzz_helpers)
4
4
(modules
5
5
fuzz
6
-
fuzz_common
7
6
fuzz_encoding
8
7
fuzz_chomping
9
8
fuzz_tag
10
9
fuzz_value
11
10
fuzz_yamlrw
12
11
fuzz_emitter))
13
-
14
-
(executable
15
-
(name fuzz_afl)
16
-
(libraries yamlrw)
17
-
(modules fuzz_afl))
18
12
19
13
(executable
20
14
(name gen_corpus)
-114
fuzz/fuzz_afl.ml
-114
fuzz/fuzz_afl.ml
···
1
-
(*---------------------------------------------------------------------------
2
-
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
-
SPDX-License-Identifier: ISC
4
-
---------------------------------------------------------------------------*)
5
-
6
-
(** AFL-specific fuzzer for yamlrw parser.
7
-
8
-
This is a standalone AFL fuzzer that reads input from a file or stdin and
9
-
exercises the parser. Build with afl-instrument for best results.
10
-
11
-
Usage:
12
-
{[
13
-
# Build with AFL instrumentation
14
-
opam switch create . ocaml-variants.5.2.0+options ocaml-option-afl
15
-
dune build fuzz/fuzz_afl.exe
16
-
17
-
# Create seed corpus
18
-
mkdir -p fuzz/input
19
-
echo -n "" > fuzz/input/empty
20
-
echo "null" > fuzz/input/null
21
-
echo "true" > fuzz/input/bool
22
-
echo "42" > fuzz/input/int
23
-
echo "3.14" > fuzz/input/float
24
-
echo "hello" > fuzz/input/string
25
-
echo "key: value" > fuzz/input/mapping
26
-
echo -e "- a\n- b" > fuzz/input/sequence
27
-
echo -e "---\nfoo\n..." > fuzz/input/document
28
-
echo "&anchor value" > fuzz/input/anchor
29
-
echo "!tag value" > fuzz/input/tag
30
-
echo -e "|\n literal\n block" > fuzz/input/literal
31
-
echo -e ">\n folded\n block" > fuzz/input/folded
32
-
echo "'single quoted'" > fuzz/input/single
33
-
echo '"double quoted"' > fuzz/input/double
34
-
35
-
# Run AFL
36
-
afl-fuzz -m none -i fuzz/input -o _fuzz -- _build/default/fuzz/fuzz_afl.exe @@
37
-
]} *)
38
-
39
-
(** Read entire file as string *)
40
-
let read_file filename =
41
-
let ic = open_in_bin filename in
42
-
let n = in_channel_length ic in
43
-
let s = really_input_string ic n in
44
-
close_in ic;
45
-
s
46
-
47
-
(** Read from stdin until EOF *)
48
-
let read_stdin () =
49
-
let buf = Buffer.create 1024 in
50
-
try
51
-
while true do
52
-
Buffer.add_channel buf stdin 1024
53
-
done;
54
-
assert false
55
-
with End_of_file -> Buffer.contents buf
56
-
57
-
(** Fuzz target: exercises all major parsing paths *)
58
-
let fuzz_target input =
59
-
(* Test value parsing *)
60
-
(try
61
-
let v = Yamlrw.of_string input in
62
-
(* Exercise serialization *)
63
-
let _ = Yamlrw.to_string v in
64
-
(* Exercise different styles *)
65
-
let _ = Yamlrw.to_string ~layout_style:`Block v in
66
-
let _ = Yamlrw.to_string ~layout_style:`Flow v in
67
-
(* Exercise pp *)
68
-
let _ = Format.asprintf "%a" Yamlrw.pp v in
69
-
()
70
-
with Yamlrw.Yamlrw_error _ -> ());
71
-
72
-
(* Test yaml parsing (with alias resolution) *)
73
-
(try
74
-
let y = Yamlrw.yaml_of_string ~resolve_aliases:true input in
75
-
let _ = Yamlrw.yaml_to_string y in
76
-
()
77
-
with Yamlrw.Yamlrw_error _ -> ());
78
-
79
-
(* Test yaml parsing (without alias resolution) *)
80
-
(try
81
-
let y = Yamlrw.yaml_of_string ~resolve_aliases:false input in
82
-
let _ = Yamlrw.yaml_to_string y in
83
-
()
84
-
with Yamlrw.Yamlrw_error _ -> ());
85
-
86
-
(* Test document parsing *)
87
-
(try
88
-
let docs = Yamlrw.documents_of_string input in
89
-
let _ = Yamlrw.documents_to_string docs in
90
-
()
91
-
with Yamlrw.Yamlrw_error _ -> ());
92
-
93
-
(* Test encoding detection *)
94
-
let enc, _ = Yamlrw.Encoding.detect input in
95
-
let _ = Yamlrw.Encoding.to_string enc in
96
-
97
-
(* Test streaming parser *)
98
-
(try
99
-
let parser = Yamlrw.Stream.parser input in
100
-
Yamlrw.Stream.iter (fun _ _ _ -> ()) parser
101
-
with Yamlrw.Yamlrw_error _ -> ());
102
-
103
-
(* Test scanner directly *)
104
-
try
105
-
let scanner = Yamlrw.Scanner.of_string input in
106
-
let _ = Yamlrw.Scanner.to_list scanner in
107
-
()
108
-
with Yamlrw.Yamlrw_error _ -> ()
109
-
110
-
let () =
111
-
let input =
112
-
if Array.length Sys.argv > 1 then read_file Sys.argv.(1) else read_stdin ()
113
-
in
114
-
fuzz_target input
fuzz/fuzz_common.ml
fuzz/helpers/fuzz_helpers.ml
fuzz/fuzz_common.ml
fuzz/helpers/fuzz_helpers.ml
+1
-1
fuzz/fuzz_emitter.ml
+1
-1
fuzz/fuzz_emitter.ml
+1
-1
fuzz/fuzz_tag.ml
+1
-1
fuzz/fuzz_tag.ml
+1
-1
fuzz/fuzz_value.ml
+1
-1
fuzz/fuzz_value.ml
+1
-1
fuzz/fuzz_yamlrw.ml
+1
-1
fuzz/fuzz_yamlrw.ml
+28
fuzz/helpers/fuzz_helpers.mli
+28
fuzz/helpers/fuzz_helpers.mli
···
1
+
(** Common utilities for yamlrw fuzz tests. *)
2
+
3
+
val to_bytes : string -> bytes
4
+
(** Convert a string to bytes. *)
5
+
6
+
val printable_char : char Crowbar.gen
7
+
(** Generator for printable ASCII characters. *)
8
+
9
+
val printable_string : string Crowbar.gen
10
+
(** Generator for printable ASCII strings. *)
11
+
12
+
val yaml_safe_char : char Crowbar.gen
13
+
(** Generator for YAML-safe characters. *)
14
+
15
+
val yaml_safe_string : string Crowbar.gen
16
+
(** Generator for YAML-safe strings. *)
17
+
18
+
val ident_char : char Crowbar.gen
19
+
(** Generator for identifier characters. *)
20
+
21
+
val ident_string : string Crowbar.gen
22
+
(** Generator for identifier-like strings. *)
23
+
24
+
val catch_invalid_arg : (unit -> unit) -> unit
25
+
(** Catch [Invalid_argument] exceptions. *)
26
+
27
+
val catch_yamlrw_error : (unit -> unit) -> unit
28
+
(** Catch [Yamlrw.Yamlrw_error] exceptions. *)