this repo has no description
sync
+451
-120
+1
-1
yaml/ocaml-yamle/bin/dune
+1
-1
yaml/ocaml-yamle/bin/dune
+92
-47
yaml/ocaml-yamle/bin/yamlcat.ml
+92
-47
yaml/ocaml-yamle/bin/yamlcat.ml
···
1
1
(** yamlcat - parse and reprint YAML files *)
2
2
3
-
let usage () =
4
-
Printf.eprintf "Usage: %s [OPTIONS] [FILE...]\n" Sys.argv.(0);
5
-
Printf.eprintf "\n";
6
-
Printf.eprintf "Parse YAML files and reprint them.\n";
7
-
Printf.eprintf "If no files are given, reads from stdin.\n";
8
-
Printf.eprintf "\n";
9
-
Printf.eprintf "Options:\n";
10
-
Printf.eprintf " --all Output all documents (for multi-document YAML)\n";
11
-
Printf.eprintf " --json Output as JSON format\n";
12
-
Printf.eprintf " --flow Output YAML in flow style\n";
13
-
Printf.eprintf " --debug Output internal representation (for debugging)\n";
14
-
Printf.eprintf " --help Show this help message\n";
15
-
exit 1
3
+
open Cmdliner
16
4
17
5
type output_format = Yaml | Json | Flow | Debug
18
6
···
47
35
json_to_string buf v;
48
36
Buffer.contents buf
49
37
50
-
let process_string ~format ~all content =
38
+
let process_string ~format ~all ~resolve_aliases ~max_nodes ~max_depth content =
51
39
try
52
40
if all then
53
41
(* Multi-document mode *)
···
67
55
| Some yaml ->
68
56
if not !first then print_endline "---";
69
57
first := false;
70
-
let value = Yamle.to_json yaml in
58
+
let value = Yamle.to_json ~resolve_aliases ~max_nodes ~max_depth yaml in
71
59
print_endline (value_to_json value)
72
60
) documents
73
61
| Debug ->
···
80
68
(* Single-document mode (original behavior) *)
81
69
match format with
82
70
| Yaml ->
83
-
let value = Yamle.of_string content in
71
+
let value = Yamle.of_string ~resolve_aliases ~max_nodes ~max_depth content in
84
72
print_string (Yamle.to_string value)
85
73
| Flow ->
86
-
let value = Yamle.of_string content in
74
+
let value = Yamle.of_string ~resolve_aliases ~max_nodes ~max_depth content in
87
75
print_string (Yamle.to_string ~layout_style:Yamle.Layout_style.Flow value)
88
76
| Json ->
89
-
let value = Yamle.of_string content in
77
+
let value = Yamle.of_string ~resolve_aliases ~max_nodes ~max_depth content in
90
78
print_endline (value_to_json value)
91
79
| Debug ->
92
-
let yaml = Yamle.yaml_of_string content in
80
+
let yaml = Yamle.yaml_of_string ~resolve_aliases ~max_nodes ~max_depth content in
93
81
Format.printf "%a@." Yamle.pp_yaml yaml
94
82
with
95
83
| Yamle.Yamle_error e ->
96
84
Printf.eprintf "Error: %s\n" (Yamle.Error.to_string e);
97
85
exit 1
98
86
99
-
let process_file ~format ~all filename =
87
+
let process_file ~format ~all ~resolve_aliases ~max_nodes ~max_depth filename =
100
88
let content =
101
89
if filename = "-" then
102
90
In_channel.input_all In_channel.stdin
103
91
else
104
92
In_channel.with_open_text filename In_channel.input_all
105
93
in
106
-
process_string ~format ~all content
94
+
process_string ~format ~all ~resolve_aliases ~max_nodes ~max_depth content
95
+
96
+
let run format all resolve_aliases max_nodes max_depth files =
97
+
let files = if files = [] then ["-"] else files in
98
+
List.iter (process_file ~format ~all ~resolve_aliases ~max_nodes ~max_depth) files;
99
+
`Ok ()
100
+
101
+
(* Command-line arguments *)
102
+
103
+
let format_arg =
104
+
let doc = "Output format: yaml (default), json, flow, or debug." in
105
+
let formats = [
106
+
("yaml", Yaml);
107
+
("json", Json);
108
+
("flow", Flow);
109
+
("debug", Debug);
110
+
] in
111
+
Arg.(value & opt (enum formats) Yaml & info ["format"; "f"] ~docv:"FORMAT" ~doc)
112
+
113
+
let json_arg =
114
+
let doc = "Output as JSON (shorthand for --format=json)." in
115
+
Arg.(value & flag & info ["json"] ~doc)
116
+
117
+
let flow_arg =
118
+
let doc = "Output in flow style (shorthand for --format=flow)." in
119
+
Arg.(value & flag & info ["flow"] ~doc)
120
+
121
+
let debug_arg =
122
+
let doc = "Output internal representation (shorthand for --format=debug)." in
123
+
Arg.(value & flag & info ["debug"] ~doc)
124
+
125
+
let all_arg =
126
+
let doc = "Output all documents (for multi-document YAML)." in
127
+
Arg.(value & flag & info ["all"; "a"] ~doc)
128
+
129
+
let no_resolve_aliases_arg =
130
+
let doc = "Don't resolve aliases (keep them as references)." in
131
+
Arg.(value & flag & info ["no-resolve-aliases"] ~doc)
132
+
133
+
let max_nodes_arg =
134
+
let doc = "Maximum number of nodes during alias expansion (default: 10000000). \
135
+
Protection against billion laughs attack." in
136
+
Arg.(value & opt int Yamle.default_max_alias_nodes & info ["max-nodes"] ~docv:"N" ~doc)
107
137
108
-
let () =
109
-
let files = ref [] in
110
-
let format = ref Yaml in
111
-
let show_help = ref false in
112
-
let all = ref false in
138
+
let max_depth_arg =
139
+
let doc = "Maximum alias nesting depth (default: 100). \
140
+
Protection against deeply nested alias chains." in
141
+
Arg.(value & opt int Yamle.default_max_alias_depth & info ["max-depth"] ~docv:"N" ~doc)
113
142
114
-
(* Parse arguments *)
115
-
let args = Array.to_list Sys.argv |> List.tl in
116
-
List.iter (fun arg ->
117
-
match arg with
118
-
| "--help" | "-h" -> show_help := true
119
-
| "--all" -> all := true
120
-
| "--json" -> format := Json
121
-
| "--flow" -> format := Flow
122
-
| "--debug" -> format := Debug
123
-
| s when String.length s > 0 && s.[0] = '-' ->
124
-
Printf.eprintf "Unknown option: %s\n" s;
125
-
usage ()
126
-
| filename -> files := filename :: !files
127
-
) args;
143
+
let files_arg =
144
+
let doc = "YAML file(s) to process. Use '-' for stdin." in
145
+
Arg.(value & pos_all file [] & info [] ~docv:"FILE" ~doc)
146
+
147
+
let combined_format format json flow debug =
148
+
if json then Json
149
+
else if flow then Flow
150
+
else if debug then Debug
151
+
else format
128
152
129
-
if !show_help then usage ();
153
+
let term =
154
+
let combine format json flow debug all no_resolve max_nodes max_depth files =
155
+
let format = combined_format format json flow debug in
156
+
let resolve_aliases = not no_resolve in
157
+
run format all resolve_aliases max_nodes max_depth files
158
+
in
159
+
Term.(ret (const combine $ format_arg $ json_arg $ flow_arg $ debug_arg $
160
+
all_arg $ no_resolve_aliases_arg $ max_nodes_arg $ max_depth_arg $ files_arg))
130
161
131
-
let files = List.rev !files in
162
+
let info =
163
+
let doc = "Parse and reprint YAML files" in
164
+
let man = [
165
+
`S Manpage.s_description;
166
+
`P "$(tname) parses YAML files and reprints them in various formats. \
167
+
It can be used to validate YAML, convert between styles, or convert to JSON.";
168
+
`S Manpage.s_examples;
169
+
`P "Parse and reprint a YAML file:";
170
+
`Pre " $(tname) config.yaml";
171
+
`P "Convert YAML to JSON:";
172
+
`Pre " $(tname) --json config.yaml";
173
+
`P "Process multi-document YAML:";
174
+
`Pre " $(tname) --all multi.yaml";
175
+
`P "Limit alias expansion (protection against malicious YAML):";
176
+
`Pre " $(tname) --max-nodes 1000 --max-depth 10 untrusted.yaml";
177
+
`S Manpage.s_bugs;
178
+
`P "Report bugs at https://github.com/avsm/ocaml-yaml/issues";
179
+
] in
180
+
Cmd.info "yamlcat" ~version:"0.1.0" ~doc ~man
132
181
133
-
if files = [] then
134
-
(* Read from stdin *)
135
-
process_file ~format:!format ~all:!all "-"
136
-
else
137
-
List.iter (process_file ~format:!format ~all:!all) files
182
+
let () = exit (Cmd.eval (Cmd.v info term))
+6
yaml/ocaml-yamle/lib/error.ml
+6
yaml/ocaml-yamle/lib/error.ml
···
45
45
| Type_mismatch of string * string (** expected, got *)
46
46
| Unresolved_alias of string
47
47
| Key_not_found of string
48
+
| Alias_expansion_node_limit of int (** max nodes exceeded *)
49
+
| Alias_expansion_depth_limit of int (** max depth exceeded *)
48
50
49
51
(* Emitter errors *)
50
52
| Invalid_encoding of string
···
138
140
Printf.sprintf "type mismatch: expected %s, got %s" expected got
139
141
| Unresolved_alias s -> Printf.sprintf "unresolved alias: *%s" s
140
142
| Key_not_found s -> Printf.sprintf "key not found: %s" s
143
+
| Alias_expansion_node_limit n ->
144
+
Printf.sprintf "alias expansion exceeded node limit (%d nodes)" n
145
+
| Alias_expansion_depth_limit n ->
146
+
Printf.sprintf "alias expansion exceeded depth limit (%d levels)" n
141
147
| Invalid_encoding s -> Printf.sprintf "invalid encoding: %s" s
142
148
| Scalar_contains_invalid_chars s ->
143
149
Printf.sprintf "scalar contains invalid characters: %s" s
+40
-11
yaml/ocaml-yamle/lib/loader.ml
+40
-11
yaml/ocaml-yamle/lib/loader.ml
···
127
127
pending_key = None;
128
128
} :: rest)
129
129
130
-
(** Load single document as Value *)
131
-
let value_of_string s =
130
+
(** Load single document as Value.
131
+
132
+
@param resolve_aliases Whether to resolve aliases (default true)
133
+
@param max_nodes Maximum nodes during alias expansion (default 10M)
134
+
@param max_depth Maximum alias nesting depth (default 100)
135
+
*)
136
+
let value_of_string
137
+
?(resolve_aliases = true)
138
+
?(max_nodes = Yaml.default_max_alias_nodes)
139
+
?(max_depth = Yaml.default_max_alias_depth)
140
+
s =
132
141
let parser = Parser.of_string s in
133
142
let state = create_state () in
134
143
Parser.iter (process_event state) parser;
···
138
147
(match Document.root doc with
139
148
| None -> `Null
140
149
| Some yaml ->
141
-
let yaml = Yaml.resolve_aliases yaml in
142
-
Yaml.to_value yaml)
150
+
Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth yaml)
143
151
| _ -> Error.raise Multiple_documents
144
152
145
-
(** Load single document as Yaml *)
146
-
let yaml_of_string s =
153
+
(** Load single document as Yaml.
154
+
155
+
@param resolve_aliases Whether to resolve aliases (default false for Yaml.t)
156
+
@param max_nodes Maximum nodes during alias expansion (default 10M)
157
+
@param max_depth Maximum alias nesting depth (default 100)
158
+
*)
159
+
let yaml_of_string
160
+
?(resolve_aliases = false)
161
+
?(max_nodes = Yaml.default_max_alias_nodes)
162
+
?(max_depth = Yaml.default_max_alias_depth)
163
+
s =
147
164
let parser = Parser.of_string s in
148
165
let state = create_state () in
149
166
Parser.iter (process_event state) parser;
···
152
169
| [doc] ->
153
170
(match Document.root doc with
154
171
| None -> `Scalar (Scalar.make "")
155
-
| Some yaml -> yaml)
172
+
| Some yaml ->
173
+
if resolve_aliases then
174
+
Yaml.resolve_aliases ~max_nodes ~max_depth yaml
175
+
else
176
+
yaml)
156
177
| _ -> Error.raise Multiple_documents
157
178
158
179
(** Load all documents *)
···
162
183
Parser.iter (process_event state) parser;
163
184
List.rev state.documents
164
185
165
-
(** Load single Value from parser *)
166
-
let load_value parser =
186
+
(** Load single Value from parser.
187
+
188
+
@param resolve_aliases Whether to resolve aliases (default true)
189
+
@param max_nodes Maximum nodes during alias expansion (default 10M)
190
+
@param max_depth Maximum alias nesting depth (default 100)
191
+
*)
192
+
let load_value
193
+
?(resolve_aliases = true)
194
+
?(max_nodes = Yaml.default_max_alias_nodes)
195
+
?(max_depth = Yaml.default_max_alias_depth)
196
+
parser =
167
197
let state = create_state () in
168
198
let rec loop () =
169
199
match Parser.next parser with
···
178
208
Some (match Document.root doc with
179
209
| None -> `Null
180
210
| Some yaml ->
181
-
let yaml = Yaml.resolve_aliases yaml in
182
-
Yaml.to_value yaml)
211
+
Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth yaml)
183
212
| [] -> None)
184
213
| Event.Stream_end -> None
185
214
| _ -> loop ()
+89
-56
yaml/ocaml-yamle/lib/yaml.ml
+89
-56
yaml/ocaml-yamle/lib/yaml.ml
···
50
50
(`Scalar (Scalar.make k), of_value v)
51
51
) pairs))
52
52
53
-
(** Convert to JSON-compatible Value *)
53
+
(** Default limits for alias expansion (protection against billion laughs attack) *)
54
+
let default_max_alias_nodes = 10_000_000
55
+
let default_max_alias_depth = 100
56
+
57
+
(** Resolve aliases by replacing them with referenced nodes.
58
+
59
+
@param max_nodes Maximum number of nodes to create during expansion (default 10M)
60
+
@param max_depth Maximum depth of alias-within-alias resolution (default 100)
61
+
@raise Alias_expansion_node_limit if max_nodes is exceeded
62
+
@raise Alias_expansion_depth_limit if max_depth is exceeded
63
+
*)
64
+
let resolve_aliases ?(max_nodes = default_max_alias_nodes) ?(max_depth = default_max_alias_depth) (root : t) : t =
65
+
let anchors = Hashtbl.create 16 in
66
+
let node_count = ref 0 in
67
+
68
+
(* Check node limit *)
69
+
let check_node_limit () =
70
+
incr node_count;
71
+
if !node_count > max_nodes then
72
+
Error.raise (Alias_expansion_node_limit max_nodes)
73
+
in
74
+
75
+
(* First pass: collect all anchors *)
76
+
let rec collect (v : t) =
77
+
match v with
78
+
| `Scalar s ->
79
+
(match Scalar.anchor s with
80
+
| Some name -> Hashtbl.replace anchors name v
81
+
| None -> ())
82
+
| `Alias _ -> ()
83
+
| `A seq ->
84
+
(match Sequence.anchor seq with
85
+
| Some name -> Hashtbl.replace anchors name v
86
+
| None -> ());
87
+
List.iter collect (Sequence.members seq)
88
+
| `O map ->
89
+
(match Mapping.anchor map with
90
+
| Some name -> Hashtbl.replace anchors name v
91
+
| None -> ());
92
+
List.iter (fun (k, v) -> collect k; collect v) (Mapping.members map)
93
+
in
94
+
collect root;
54
95
55
-
let rec to_value (v : t) : Value.t =
56
-
match v with
57
-
| `Scalar s -> scalar_to_value s
58
-
| `Alias name -> Error.raise (Unresolved_alias name)
59
-
| `A seq -> `A (List.map to_value (Sequence.members seq))
60
-
| `O map ->
61
-
`O (List.map (fun (k, v) ->
62
-
let key = match k with
63
-
| `Scalar s -> Scalar.value s
64
-
| _ -> Error.raise (Type_mismatch ("string key", "complex key"))
65
-
in
66
-
(key, to_value v)
67
-
) (Mapping.members map))
96
+
(* Second pass: resolve aliases with depth tracking *)
97
+
let rec resolve ~depth (v : t) : t =
98
+
check_node_limit ();
99
+
match v with
100
+
| `Scalar _ -> v
101
+
| `Alias name ->
102
+
if depth >= max_depth then
103
+
Error.raise (Alias_expansion_depth_limit max_depth);
104
+
(match Hashtbl.find_opt anchors name with
105
+
| Some target -> resolve ~depth:(depth + 1) target
106
+
| None -> Error.raise (Undefined_alias name))
107
+
| `A seq ->
108
+
`A (Sequence.map (resolve ~depth) seq)
109
+
| `O map ->
110
+
`O (Mapping.make
111
+
?anchor:(Mapping.anchor map)
112
+
?tag:(Mapping.tag map)
113
+
~implicit:(Mapping.implicit map)
114
+
~style:(Mapping.style map)
115
+
(List.map (fun (k, v) -> (resolve ~depth k, resolve ~depth v)) (Mapping.members map)))
116
+
in
117
+
resolve ~depth:0 root
68
118
69
119
(** Convert scalar to JSON value based on content *)
70
-
and scalar_to_value s =
120
+
let rec scalar_to_value s =
71
121
let value = Scalar.value s in
72
122
let tag = Scalar.tag s in
73
123
let style = Scalar.style s in
···
161
211
(* Not a number - it's a string *)
162
212
`String value
163
213
164
-
(** Resolve aliases by replacing them with referenced nodes *)
214
+
(** Convert to JSON-compatible Value.
165
215
166
-
let resolve_aliases (root : t) : t =
167
-
let anchors = Hashtbl.create 16 in
168
-
169
-
(* First pass: collect all anchors *)
170
-
let rec collect (v : t) =
216
+
@param resolve_aliases_first Whether to resolve aliases before conversion (default true)
217
+
@param max_nodes Maximum nodes during alias expansion (default 10M)
218
+
@param max_depth Maximum alias nesting depth (default 100)
219
+
@raise Unresolved_alias if resolve_aliases_first is false and an alias is encountered
220
+
*)
221
+
let to_value
222
+
?(resolve_aliases_first = true)
223
+
?(max_nodes = default_max_alias_nodes)
224
+
?(max_depth = default_max_alias_depth)
225
+
(v : t) : Value.t =
226
+
let v = if resolve_aliases_first then resolve_aliases ~max_nodes ~max_depth v else v in
227
+
let rec convert (v : t) : Value.t =
171
228
match v with
172
-
| `Scalar s ->
173
-
(match Scalar.anchor s with
174
-
| Some name -> Hashtbl.replace anchors name v
175
-
| None -> ())
176
-
| `Alias _ -> ()
177
-
| `A seq ->
178
-
(match Sequence.anchor seq with
179
-
| Some name -> Hashtbl.replace anchors name v
180
-
| None -> ());
181
-
List.iter collect (Sequence.members seq)
229
+
| `Scalar s -> scalar_to_value s
230
+
| `Alias name -> Error.raise (Unresolved_alias name)
231
+
| `A seq -> `A (List.map convert (Sequence.members seq))
182
232
| `O map ->
183
-
(match Mapping.anchor map with
184
-
| Some name -> Hashtbl.replace anchors name v
185
-
| None -> ());
186
-
List.iter (fun (k, v) -> collect k; collect v) (Mapping.members map)
187
-
in
188
-
collect root;
189
-
190
-
(* Second pass: resolve aliases *)
191
-
let rec resolve (v : t) : t =
192
-
match v with
193
-
| `Scalar _ -> v
194
-
| `Alias name ->
195
-
(match Hashtbl.find_opt anchors name with
196
-
| Some target -> resolve target
197
-
| None -> Error.raise (Undefined_alias name))
198
-
| `A seq ->
199
-
`A (Sequence.map resolve seq)
200
-
| `O map ->
201
-
`O (Mapping.make
202
-
?anchor:(Mapping.anchor map)
203
-
?tag:(Mapping.tag map)
204
-
~implicit:(Mapping.implicit map)
205
-
~style:(Mapping.style map)
206
-
(List.map (fun (k, v) -> (resolve k, resolve v)) (Mapping.members map)))
233
+
`O (List.map (fun (k, v) ->
234
+
let key = match k with
235
+
| `Scalar s -> Scalar.value s
236
+
| _ -> Error.raise (Type_mismatch ("string key", "complex key"))
237
+
in
238
+
(key, convert v)
239
+
) (Mapping.members map))
207
240
in
208
-
resolve root
241
+
convert v
209
242
210
243
(** Get anchor from any node *)
211
244
let anchor (v : t) =
+23
-5
yaml/ocaml-yamle/lib/yamle.ml
+23
-5
yaml/ocaml-yamle/lib/yamle.ml
···
12
12
type error = Error.t
13
13
exception Yamle_error = Error.Yamle_error
14
14
15
+
(** {1 Alias expansion limits (protection against billion laughs attack)} *)
16
+
17
+
let default_max_alias_nodes = Yaml.default_max_alias_nodes
18
+
let default_max_alias_depth = Yaml.default_max_alias_depth
19
+
15
20
(** {1 JSON-compatible parsing} *)
16
21
17
-
let of_string s = Loader.value_of_string s
22
+
let of_string
23
+
?(resolve_aliases = true)
24
+
?(max_nodes = default_max_alias_nodes)
25
+
?(max_depth = default_max_alias_depth)
26
+
s =
27
+
Loader.value_of_string ~resolve_aliases ~max_nodes ~max_depth s
18
28
19
29
let documents_of_string s = Loader.documents_of_string s
20
30
···
35
45
36
46
(** {1 YAML-specific parsing} *)
37
47
38
-
let yaml_of_string s = Loader.yaml_of_string s
48
+
let yaml_of_string
49
+
?(resolve_aliases = false)
50
+
?(max_nodes = default_max_alias_nodes)
51
+
?(max_depth = default_max_alias_depth)
52
+
s =
53
+
Loader.yaml_of_string ~resolve_aliases ~max_nodes ~max_depth s
39
54
40
55
(** {1 YAML-specific emission} *)
41
56
···
67
82
68
83
(** {1 Conversion} *)
69
84
70
-
let to_json yaml =
71
-
let yaml = Yaml.resolve_aliases yaml in
72
-
Yaml.to_value yaml
85
+
let to_json
86
+
?(resolve_aliases = true)
87
+
?(max_nodes = default_max_alias_nodes)
88
+
?(max_depth = default_max_alias_depth)
89
+
yaml =
90
+
Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth yaml
73
91
74
92
let of_json value = Yaml.of_value value
75
93
+113
yaml/ocaml-yamle/tests/cram/bomb.t
+113
yaml/ocaml-yamle/tests/cram/bomb.t
···
1
+
Billion laughs attack protection tests
2
+
3
+
Create a small bomb file for testing:
4
+
5
+
$ cat > bomb_small.yml << 'EOF'
6
+
> # Small "billion laughs" style YAML bomb for testing
7
+
> # Expands to 9^4 = 6561 nodes when aliases are resolved
8
+
> a: &a [1, 2, 3, 4, 5, 6, 7, 8, 9]
9
+
> b: &b [*a, *a, *a, *a, *a, *a, *a, *a, *a]
10
+
> c: &c [*b, *b, *b, *b, *b, *b, *b, *b, *b]
11
+
> d: &d [*c, *c, *c, *c, *c, *c, *c, *c, *c]
12
+
> EOF
13
+
14
+
Test with a tight node limit (small bomb would expand to ~6561 nodes):
15
+
16
+
$ yamlcat --max-nodes 100 --json bomb_small.yml
17
+
Error: alias expansion exceeded node limit (100 nodes)
18
+
[1]
19
+
20
+
Test with a limit that allows the small bomb:
21
+
22
+
$ yamlcat --max-nodes 10000 --json bomb_small.yml | head -c 100
23
+
{"a": [1, 2, 3, 4, 5, 6, 7, 8, 9], "b": [[1, 2, 3, 4, 5, 6, 7, 8, 9], [1, 2, 3, 4, 5, 6, 7, 8, 9], [
24
+
25
+
Test depth limit with a nested alias chain:
26
+
27
+
$ cat > depth_bomb.yml << 'EOF'
28
+
> a: &a [x, y, z]
29
+
> b: &b [*a, *a]
30
+
> c: &c [*b, *b]
31
+
> d: &d [*c, *c]
32
+
> e: &e [*d, *d]
33
+
> result: *e
34
+
> EOF
35
+
36
+
$ yamlcat --max-depth 2 --json depth_bomb.yml
37
+
Error: alias expansion exceeded depth limit (2 levels)
38
+
[1]
39
+
40
+
$ yamlcat --max-depth 10 --json depth_bomb.yml | head -c 50
41
+
{"a": ["x", "y", "z"], "b": [["x", "y", "z"], ["x"
42
+
43
+
Test that --no-resolve-aliases keeps aliases as-is (in debug mode):
44
+
45
+
$ cat > simple_alias.yml << 'EOF'
46
+
> anchor: &anc hello
47
+
> alias: *anc
48
+
> EOF
49
+
50
+
$ yamlcat --no-resolve-aliases --debug simple_alias.yml
51
+
mapping(
52
+
style=block,
53
+
members={
54
+
scalar("anchor", style=plain): scalar("hello", anchor=anc, style=plain),
55
+
scalar("alias", style=plain): *anc
56
+
})
57
+
58
+
With resolve (default), aliases are expanded:
59
+
60
+
$ yamlcat --json simple_alias.yml
61
+
{"anchor": "hello", "alias": "hello"}
62
+
63
+
Create a full bomb (like the one in ocaml-yaml):
64
+
65
+
$ cat > bomb.yml << 'EOF'
66
+
> a: &a ["lol","lol","lol","lol","lol","lol","lol","lol","lol"]
67
+
> b: &b [*a,*a,*a,*a,*a,*a,*a,*a,*a]
68
+
> c: &c [*b,*b,*b,*b,*b,*b,*b,*b,*b]
69
+
> d: &d [*c,*c,*c,*c,*c,*c,*c,*c,*c]
70
+
> e: &e [*d,*d,*d,*d,*d,*d,*d,*d,*d]
71
+
> f: &f [*e,*e,*e,*e,*e,*e,*e,*e,*e]
72
+
> g: &g [*f,*f,*f,*f,*f,*f,*f,*f,*f]
73
+
> h: &h [*g,*g,*g,*g,*g,*g,*g,*g,*g]
74
+
> i: &i [*h,*h,*h,*h,*h,*h,*h,*h,*h]
75
+
> EOF
76
+
77
+
Test the full bomb is rejected with default limits:
78
+
79
+
$ yamlcat --json bomb.yml 2>&1 | head -1
80
+
Error: alias expansion exceeded node limit (10000000 nodes)
81
+
82
+
With a very small limit:
83
+
84
+
$ yamlcat --max-nodes 50 --json bomb.yml
85
+
Error: alias expansion exceeded node limit (50 nodes)
86
+
[1]
87
+
88
+
Test that valid YAML with aliases works:
89
+
90
+
$ cat > valid.yml << 'EOF'
91
+
> defaults: &defaults
92
+
> timeout: 30
93
+
> retries: 3
94
+
> production:
95
+
> <<: *defaults
96
+
> port: 8080
97
+
> EOF
98
+
99
+
$ yamlcat --json valid.yml
100
+
{"defaults": {"timeout": 30, "retries": 3}, "production": {"<<": {"timeout": 30, "retries": 3}, "port": 8080}}
101
+
102
+
Test help includes the new options:
103
+
104
+
$ yamlcat --help=plain | grep 'max-nodes'
105
+
--max-nodes=N (absent=10000000)
106
+
yamlcat --max-nodes 1000 --max-depth 10 untrusted.yaml
107
+
108
+
$ yamlcat --help=plain | grep 'max-depth'
109
+
--max-depth=N (absent=100)
110
+
yamlcat --max-nodes 1000 --max-depth 10 untrusted.yaml
111
+
112
+
$ yamlcat --help=plain | grep 'no-resolve-aliases'
113
+
--no-resolve-aliases
+6
yaml/ocaml-yamle/tests/cram/bomb_small.yml
+6
yaml/ocaml-yamle/tests/cram/bomb_small.yml
+81
yaml/ocaml-yamle/tests/test_yamle.ml
+81
yaml/ocaml-yamle/tests/test_yamle.ml
···
248
248
"error position", `Quick, test_error_position;
249
249
]
250
250
251
+
(** Alias expansion limit tests (billion laughs protection) *)
252
+
253
+
let test_node_limit () =
254
+
(* Small bomb that would expand to 9^4 = 6561 nodes *)
255
+
let yaml = {|
256
+
a: &a [1,2,3,4,5,6,7,8,9]
257
+
b: &b [*a,*a,*a,*a,*a,*a,*a,*a,*a]
258
+
c: &c [*b,*b,*b,*b,*b,*b,*b,*b,*b]
259
+
d: &d [*c,*c,*c,*c,*c,*c,*c,*c,*c]
260
+
|} in
261
+
(* Should fail with a small node limit *)
262
+
try
263
+
let _ = of_string ~max_nodes:100 yaml in
264
+
Alcotest.fail "expected node limit error"
265
+
with
266
+
| Yamle_error e ->
267
+
(match e.Error.kind with
268
+
| Error.Alias_expansion_node_limit _ -> ()
269
+
| _ -> Alcotest.fail "expected Alias_expansion_node_limit error")
270
+
271
+
let test_depth_limit () =
272
+
(* Create deeply nested alias chain:
273
+
*e -> [*d,*d] -> [*c,*c] -> [*b,*b] -> [*a,*a] -> [x,y,z]
274
+
Each alias resolution increases depth by 1 *)
275
+
let yaml = {|
276
+
a: &a [x, y, z]
277
+
b: &b [*a, *a]
278
+
c: &c [*b, *b]
279
+
d: &d [*c, *c]
280
+
e: &e [*d, *d]
281
+
result: *e
282
+
|} in
283
+
(* Should fail with a small depth limit (depth 3 means max 3 alias hops) *)
284
+
try
285
+
let _ = of_string ~max_depth:3 yaml in
286
+
Alcotest.fail "expected depth limit error"
287
+
with
288
+
| Yamle_error e ->
289
+
(match e.Error.kind with
290
+
| Error.Alias_expansion_depth_limit _ -> ()
291
+
| _ -> Alcotest.fail ("expected Alias_expansion_depth_limit error, got: " ^ Error.kind_to_string e.Error.kind))
292
+
293
+
let test_normal_aliases_work () =
294
+
(* Normal alias usage should work fine *)
295
+
let yaml = {|
296
+
defaults: &defaults
297
+
timeout: 30
298
+
retries: 3
299
+
production:
300
+
<<: *defaults
301
+
port: 8080
302
+
|} in
303
+
let result = of_string yaml in
304
+
match result with
305
+
| `O _ -> ()
306
+
| _ -> Alcotest.fail "expected mapping"
307
+
308
+
let test_resolve_aliases_false () =
309
+
(* With resolve_aliases=false, aliases should remain unresolved *)
310
+
let yaml = {|
311
+
a: &anchor value
312
+
b: *anchor
313
+
|} in
314
+
let result = yaml_of_string ~resolve_aliases:false yaml in
315
+
(* Check that alias is preserved *)
316
+
match result with
317
+
| `O map ->
318
+
let pairs = Mapping.members map in
319
+
(match List.assoc_opt (`Scalar (Scalar.make "b")) pairs with
320
+
| Some (`Alias "anchor") -> ()
321
+
| _ -> Alcotest.fail "expected alias to be preserved")
322
+
| _ -> Alcotest.fail "expected mapping"
323
+
324
+
let alias_limit_tests = [
325
+
"node limit", `Quick, test_node_limit;
326
+
"depth limit", `Quick, test_depth_limit;
327
+
"normal aliases work", `Quick, test_normal_aliases_work;
328
+
"resolve_aliases false", `Quick, test_resolve_aliases_false;
329
+
]
330
+
251
331
(** Run all tests *)
252
332
253
333
let () =
···
259
339
"yaml", yaml_tests;
260
340
"multiline", multiline_tests;
261
341
"errors", error_tests;
342
+
"alias_limits", alias_limit_tests;
262
343
]