commit 69fbcf44cb867a5a3b8933a9833afd001774a503 · anil.recoil.org/slop

+1 -1

yaml/ocaml-yamle/bin/dune

···

       1
       1
        
       (executable

     

       2
       2
        
        (name yamlcat)

     

       3
       3
        
        (public_name yamlcat)

     

       4
       4
       -
        (libraries yamle))

     

       4
       4
       +
        (libraries yamle cmdliner))

     

       5
       5
        
       

     

       6
       6
        
       (executable

     

       7
       7
        
        (name test_emit)

+92 -47

yaml/ocaml-yamle/bin/yamlcat.ml

···

       1
       1
        
       (** yamlcat - parse and reprint YAML files *)

     

       2
       2
        
       

     

       3
       3
       -
       let usage () =

     

       4
       4
       -
         Printf.eprintf "Usage: %s [OPTIONS] [FILE...]\n" Sys.argv.(0);

     

       5
       5
       -
         Printf.eprintf "\n";

     

       6
       6
       -
         Printf.eprintf "Parse YAML files and reprint them.\n";

     

       7
       7
       -
         Printf.eprintf "If no files are given, reads from stdin.\n";

     

       8
       8
       -
         Printf.eprintf "\n";

     

       9
       9
       -
         Printf.eprintf "Options:\n";

     

       10
       10
       -
         Printf.eprintf "  --all      Output all documents (for multi-document YAML)\n";

     

       11
       11
       -
         Printf.eprintf "  --json     Output as JSON format\n";

     

       12
       12
       -
         Printf.eprintf "  --flow     Output YAML in flow style\n";

     

       13
       13
       -
         Printf.eprintf "  --debug    Output internal representation (for debugging)\n";

     

       14
       14
       -
         Printf.eprintf "  --help     Show this help message\n";

     

       15
       15
       -
         exit 1

     

       3
       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
       50
       -
       let process_string ~format ~all content =

     

       38
       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
       70
       -
                       let value = Yamle.to_json yaml in

     

       58
       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
       83
       -
                 let value = Yamle.of_string content in

     

       71
       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
       86
       -
                 let value = Yamle.of_string content in

     

       74
       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
       89
       -
                 let value = Yamle.of_string content in

     

       77
       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
       92
       -
                 let yaml = Yamle.yaml_of_string content in

     

       80
       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
       99
       -
       let process_file ~format ~all filename =

     

       87
       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
       106
       -
         process_string ~format ~all content

     

       94
       94
       +
         process_string ~format ~all ~resolve_aliases ~max_nodes ~max_depth content

     

       95
       95
       +
       

     

       96
       96
       +
       let run format all resolve_aliases max_nodes max_depth files =

     

       97
       97
       +
         let files = if files = [] then ["-"] else files in

     

       98
       98
       +
         List.iter (process_file ~format ~all ~resolve_aliases ~max_nodes ~max_depth) files;

     

       99
       99
       +
         `Ok ()

     

       100
       100
       +
       

     

       101
       101
       +
       (* Command-line arguments *)

     

       102
       102
       +
       

     

       103
       103
       +
       let format_arg =

     

       104
       104
       +
         let doc = "Output format: yaml (default), json, flow, or debug." in

     

       105
       105
       +
         let formats = [

     

       106
       106
       +
           ("yaml", Yaml);

     

       107
       107
       +
           ("json", Json);

     

       108
       108
       +
           ("flow", Flow);

     

       109
       109
       +
           ("debug", Debug);

     

       110
       110
       +
         ] in

     

       111
       111
       +
         Arg.(value & opt (enum formats) Yaml & info ["format"; "f"] ~docv:"FORMAT" ~doc)

     

       112
       112
       +
       

     

       113
       113
       +
       let json_arg =

     

       114
       114
       +
         let doc = "Output as JSON (shorthand for --format=json)." in

     

       115
       115
       +
         Arg.(value & flag & info ["json"] ~doc)

     

       116
       116
       +
       

     

       117
       117
       +
       let flow_arg =

     

       118
       118
       +
         let doc = "Output in flow style (shorthand for --format=flow)." in

     

       119
       119
       +
         Arg.(value & flag & info ["flow"] ~doc)

     

       120
       120
       +
       

     

       121
       121
       +
       let debug_arg =

     

       122
       122
       +
         let doc = "Output internal representation (shorthand for --format=debug)." in

     

       123
       123
       +
         Arg.(value & flag & info ["debug"] ~doc)

     

       124
       124
       +
       

     

       125
       125
       +
       let all_arg =

     

       126
       126
       +
         let doc = "Output all documents (for multi-document YAML)." in

     

       127
       127
       +
         Arg.(value & flag & info ["all"; "a"] ~doc)

     

       128
       128
       +
       

     

       129
       129
       +
       let no_resolve_aliases_arg =

     

       130
       130
       +
         let doc = "Don't resolve aliases (keep them as references)." in

     

       131
       131
       +
         Arg.(value & flag & info ["no-resolve-aliases"] ~doc)

     

       132
       132
       +
       

     

       133
       133
       +
       let max_nodes_arg =

     

       134
       134
       +
         let doc = "Maximum number of nodes during alias expansion (default: 10000000). \

     

       135
       135
       +
                    Protection against billion laughs attack." in

     

       136
       136
       +
         Arg.(value & opt int Yamle.default_max_alias_nodes & info ["max-nodes"] ~docv:"N" ~doc)

     

       107
       137
        
       

     

       108
       108
       -
       let () =

     

       109
       109
       -
         let files = ref [] in

     

       110
       110
       -
         let format = ref Yaml in

     

       111
       111
       -
         let show_help = ref false in

     

       112
       112
       -
         let all = ref false in

     

       138
       138
       +
       let max_depth_arg =

     

       139
       139
       +
         let doc = "Maximum alias nesting depth (default: 100). \

     

       140
       140
       +
                    Protection against deeply nested alias chains." in

     

       141
       141
       +
         Arg.(value & opt int Yamle.default_max_alias_depth & info ["max-depth"] ~docv:"N" ~doc)

     

       113
       142
        
       

     

       114
       114
       -
         (* Parse arguments *)

     

       115
       115
       -
         let args = Array.to_list Sys.argv |> List.tl in

     

       116
       116
       -
         List.iter (fun arg ->

     

       117
       117
       -
           match arg with

     

       118
       118
       -
           | "--help" | "-h" -> show_help := true

     

       119
       119
       -
           | "--all" -> all := true

     

       120
       120
       -
           | "--json" -> format := Json

     

       121
       121
       -
           | "--flow" -> format := Flow

     

       122
       122
       -
           | "--debug" -> format := Debug

     

       123
       123
       -
           | s when String.length s > 0 && s.[0] = '-' ->

     

       124
       124
       -
               Printf.eprintf "Unknown option: %s\n" s;

     

       125
       125
       -
               usage ()

     

       126
       126
       -
           | filename -> files := filename :: !files

     

       127
       127
       -
         ) args;

     

       143
       143
       +
       let files_arg =

     

       144
       144
       +
         let doc = "YAML file(s) to process. Use '-' for stdin." in

     

       145
       145
       +
         Arg.(value & pos_all file [] & info [] ~docv:"FILE" ~doc)

     

       146
       146
       +
       

     

       147
       147
       +
       let combined_format format json flow debug =

     

       148
       148
       +
         if json then Json

     

       149
       149
       +
         else if flow then Flow

     

       150
       150
       +
         else if debug then Debug

     

       151
       151
       +
         else format

     

       128
       152
        
       

     

       129
       129
       -
         if !show_help then usage ();

     

       153
       153
       +
       let term =

     

       154
       154
       +
         let combine format json flow debug all no_resolve max_nodes max_depth files =

     

       155
       155
       +
           let format = combined_format format json flow debug in

     

       156
       156
       +
           let resolve_aliases = not no_resolve in

     

       157
       157
       +
           run format all resolve_aliases max_nodes max_depth files

     

       158
       158
       +
         in

     

       159
       159
       +
         Term.(ret (const combine $ format_arg $ json_arg $ flow_arg $ debug_arg $

     

       160
       160
       +
                    all_arg $ no_resolve_aliases_arg $ max_nodes_arg $ max_depth_arg $ files_arg))

     

       130
       161
        
       

     

       131
       131
       -
         let files = List.rev !files in

     

       162
       162
       +
       let info =

     

       163
       163
       +
         let doc = "Parse and reprint YAML files" in

     

       164
       164
       +
         let man = [

     

       165
       165
       +
           `S Manpage.s_description;

     

       166
       166
       +
           `P "$(tname) parses YAML files and reprints them in various formats. \

     

       167
       167
       +
               It can be used to validate YAML, convert between styles, or convert to JSON.";

     

       168
       168
       +
           `S Manpage.s_examples;

     

       169
       169
       +
           `P "Parse and reprint a YAML file:";

     

       170
       170
       +
           `Pre "  $(tname) config.yaml";

     

       171
       171
       +
           `P "Convert YAML to JSON:";

     

       172
       172
       +
           `Pre "  $(tname) --json config.yaml";

     

       173
       173
       +
           `P "Process multi-document YAML:";

     

       174
       174
       +
           `Pre "  $(tname) --all multi.yaml";

     

       175
       175
       +
           `P "Limit alias expansion (protection against malicious YAML):";

     

       176
       176
       +
           `Pre "  $(tname) --max-nodes 1000 --max-depth 10 untrusted.yaml";

     

       177
       177
       +
           `S Manpage.s_bugs;

     

       178
       178
       +
           `P "Report bugs at https://github.com/avsm/ocaml-yaml/issues";

     

       179
       179
       +
         ] in

     

       180
       180
       +
         Cmd.info "yamlcat" ~version:"0.1.0" ~doc ~man

     

       132
       181
        
       

     

       133
       133
       -
         if files = [] then

     

       134
       134
       -
           (* Read from stdin *)

     

       135
       135
       -
           process_file ~format:!format ~all:!all "-"

     

       136
       136
       -
         else

     

       137
       137
       -
           List.iter (process_file ~format:!format ~all:!all) files

     

       182
       182
       +
       let () = exit (Cmd.eval (Cmd.v info term))

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
       48
       +
         | Alias_expansion_node_limit of int  (** max nodes exceeded *)

     

       49
       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
       143
       +
         | Alias_expansion_node_limit n ->

     

       144
       144
       +
             Printf.sprintf "alias expansion exceeded node limit (%d nodes)" n

     

       145
       145
       +
         | Alias_expansion_depth_limit n ->

     

       146
       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

···

       127
       127
        
                    pending_key = None;

     

       128
       128
        
                  } :: rest)

     

       129
       129
        
       

     

       130
       130
       -
       (** Load single document as Value *)

     

       131
       131
       -
       let value_of_string s =

     

       130
       130
       +
       (** Load single document as Value.

     

       131
       131
       +
       

     

       132
       132
       +
           @param resolve_aliases Whether to resolve aliases (default true)

     

       133
       133
       +
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       134
       134
       +
           @param max_depth Maximum alias nesting depth (default 100)

     

       135
       135
       +
       *)

     

       136
       136
       +
       let value_of_string

     

       137
       137
       +
           ?(resolve_aliases = true)

     

       138
       138
       +
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       139
       139
       +
           ?(max_depth = Yaml.default_max_alias_depth)

     

       140
       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
       141
       -
                  let yaml = Yaml.resolve_aliases yaml in

     

       142
       142
       -
                  Yaml.to_value yaml)

     

       150
       150
       +
                  Yaml.to_value ~resolve_aliases_first:resolve_aliases ~max_nodes ~max_depth yaml)

     

       143
       151
        
         | _ -> Error.raise Multiple_documents

     

       144
       152
        
       

     

       145
       145
       -
       (** Load single document as Yaml *)

     

       146
       146
       -
       let yaml_of_string s =

     

       153
       153
       +
       (** Load single document as Yaml.

     

       154
       154
       +
       

     

       155
       155
       +
           @param resolve_aliases Whether to resolve aliases (default false for Yaml.t)

     

       156
       156
       +
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       157
       157
       +
           @param max_depth Maximum alias nesting depth (default 100)

     

       158
       158
       +
       *)

     

       159
       159
       +
       let yaml_of_string

     

       160
       160
       +
           ?(resolve_aliases = false)

     

       161
       161
       +
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       162
       162
       +
           ?(max_depth = Yaml.default_max_alias_depth)

     

       163
       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
       155
       -
              | Some yaml -> yaml)

     

       172
       172
       +
              | Some yaml ->

     

       173
       173
       +
                  if resolve_aliases then

     

       174
       174
       +
                    Yaml.resolve_aliases ~max_nodes ~max_depth yaml

     

       175
       175
       +
                  else

     

       176
       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
       165
       -
       (** Load single Value from parser *)

     

       166
       166
       -
       let load_value parser =

     

       186
       186
       +
       (** Load single Value from parser.

     

       187
       187
       +
       

     

       188
       188
       +
           @param resolve_aliases Whether to resolve aliases (default true)

     

       189
       189
       +
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       190
       190
       +
           @param max_depth Maximum alias nesting depth (default 100)

     

       191
       191
       +
       *)

     

       192
       192
       +
       let load_value

     

       193
       193
       +
           ?(resolve_aliases = true)

     

       194
       194
       +
           ?(max_nodes = Yaml.default_max_alias_nodes)

     

       195
       195
       +
           ?(max_depth = Yaml.default_max_alias_depth)

     

       196
       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
       181
       -
                              let yaml = Yaml.resolve_aliases yaml in

     

       182
       182
       -
                              Yaml.to_value yaml)

     

       211
       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

···

       50
       50
        
               (`Scalar (Scalar.make k), of_value v)

     

       51
       51
        
             ) pairs))

     

       52
       52
        
       

     

       53
       53
       -
       (** Convert to JSON-compatible Value *)

     

       53
       53
       +
       (** Default limits for alias expansion (protection against billion laughs attack) *)

     

       54
       54
       +
       let default_max_alias_nodes = 10_000_000

     

       55
       55
       +
       let default_max_alias_depth = 100

     

       56
       56
       +
       

     

       57
       57
       +
       (** Resolve aliases by replacing them with referenced nodes.

     

       58
       58
       +
       

     

       59
       59
       +
           @param max_nodes Maximum number of nodes to create during expansion (default 10M)

     

       60
       60
       +
           @param max_depth Maximum depth of alias-within-alias resolution (default 100)

     

       61
       61
       +
           @raise Alias_expansion_node_limit if max_nodes is exceeded

     

       62
       62
       +
           @raise Alias_expansion_depth_limit if max_depth is exceeded

     

       63
       63
       +
       *)

     

       64
       64
       +
       let resolve_aliases ?(max_nodes = default_max_alias_nodes) ?(max_depth = default_max_alias_depth) (root : t) : t =

     

       65
       65
       +
         let anchors = Hashtbl.create 16 in

     

       66
       66
       +
         let node_count = ref 0 in

     

       67
       67
       +
       

     

       68
       68
       +
         (* Check node limit *)

     

       69
       69
       +
         let check_node_limit () =

     

       70
       70
       +
           incr node_count;

     

       71
       71
       +
           if !node_count > max_nodes then

     

       72
       72
       +
             Error.raise (Alias_expansion_node_limit max_nodes)

     

       73
       73
       +
         in

     

       74
       74
       +
       

     

       75
       75
       +
         (* First pass: collect all anchors *)

     

       76
       76
       +
         let rec collect (v : t) =

     

       77
       77
       +
           match v with

     

       78
       78
       +
           | `Scalar s ->

     

       79
       79
       +
               (match Scalar.anchor s with

     

       80
       80
       +
                | Some name -> Hashtbl.replace anchors name v

     

       81
       81
       +
                | None -> ())

     

       82
       82
       +
           | `Alias _ -> ()

     

       83
       83
       +
           | `A seq ->

     

       84
       84
       +
               (match Sequence.anchor seq with

     

       85
       85
       +
                | Some name -> Hashtbl.replace anchors name v

     

       86
       86
       +
                | None -> ());

     

       87
       87
       +
               List.iter collect (Sequence.members seq)

     

       88
       88
       +
           | `O map ->

     

       89
       89
       +
               (match Mapping.anchor map with

     

       90
       90
       +
                | Some name -> Hashtbl.replace anchors name v

     

       91
       91
       +
                | None -> ());

     

       92
       92
       +
               List.iter (fun (k, v) -> collect k; collect v) (Mapping.members map)

     

       93
       93
       +
         in

     

       94
       94
       +
         collect root;

     

       54
       95
        
       

     

       55
       55
       -
       let rec to_value (v : t) : Value.t =

     

       56
       56
       -
         match v with

     

       57
       57
       -
         | `Scalar s -> scalar_to_value s

     

       58
       58
       -
         | `Alias name -> Error.raise (Unresolved_alias name)

     

       59
       59
       -
         | `A seq -> `A (List.map to_value (Sequence.members seq))

     

       60
       60
       -
         | `O map ->

     

       61
       61
       -
             `O (List.map (fun (k, v) ->

     

       62
       62
       -
               let key = match k with

     

       63
       63
       -
                 | `Scalar s -> Scalar.value s

     

       64
       64
       -
                 | _ -> Error.raise (Type_mismatch ("string key", "complex key"))

     

       65
       65
       -
               in

     

       66
       66
       -
               (key, to_value v)

     

       67
       67
       -
             ) (Mapping.members map))

     

       96
       96
       +
         (* Second pass: resolve aliases with depth tracking *)

     

       97
       97
       +
         let rec resolve ~depth (v : t) : t =

     

       98
       98
       +
           check_node_limit ();

     

       99
       99
       +
           match v with

     

       100
       100
       +
           | `Scalar _ -> v

     

       101
       101
       +
           | `Alias name ->

     

       102
       102
       +
               if depth >= max_depth then

     

       103
       103
       +
                 Error.raise (Alias_expansion_depth_limit max_depth);

     

       104
       104
       +
               (match Hashtbl.find_opt anchors name with

     

       105
       105
       +
                | Some target -> resolve ~depth:(depth + 1) target

     

       106
       106
       +
                | None -> Error.raise (Undefined_alias name))

     

       107
       107
       +
           | `A seq ->

     

       108
       108
       +
               `A (Sequence.map (resolve ~depth) seq)

     

       109
       109
       +
           | `O map ->

     

       110
       110
       +
               `O (Mapping.make

     

       111
       111
       +
                     ?anchor:(Mapping.anchor map)

     

       112
       112
       +
                     ?tag:(Mapping.tag map)

     

       113
       113
       +
                     ~implicit:(Mapping.implicit map)

     

       114
       114
       +
                     ~style:(Mapping.style map)

     

       115
       115
       +
                     (List.map (fun (k, v) -> (resolve ~depth k, resolve ~depth v)) (Mapping.members map)))

     

       116
       116
       +
         in

     

       117
       117
       +
         resolve ~depth:0 root

     

       68
       118
        
       

     

       69
       119
        
       (** Convert scalar to JSON value based on content *)

     

       70
       70
       -
       and scalar_to_value s =

     

       120
       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
       164
       -
       (** Resolve aliases by replacing them with referenced nodes *)

     

       214
       214
       +
       (** Convert to JSON-compatible Value.

     

       165
       215
        
       

     

       166
       166
       -
       let resolve_aliases (root : t) : t =

     

       167
       167
       -
         let anchors = Hashtbl.create 16 in

     

       168
       168
       -
       

     

       169
       169
       -
         (* First pass: collect all anchors *)

     

       170
       170
       -
         let rec collect (v : t) =

     

       216
       216
       +
           @param resolve_aliases_first Whether to resolve aliases before conversion (default true)

     

       217
       217
       +
           @param max_nodes Maximum nodes during alias expansion (default 10M)

     

       218
       218
       +
           @param max_depth Maximum alias nesting depth (default 100)

     

       219
       219
       +
           @raise Unresolved_alias if resolve_aliases_first is false and an alias is encountered

     

       220
       220
       +
       *)

     

       221
       221
       +
       let to_value

     

       222
       222
       +
           ?(resolve_aliases_first = true)

     

       223
       223
       +
           ?(max_nodes = default_max_alias_nodes)

     

       224
       224
       +
           ?(max_depth = default_max_alias_depth)

     

       225
       225
       +
           (v : t) : Value.t =

     

       226
       226
       +
         let v = if resolve_aliases_first then resolve_aliases ~max_nodes ~max_depth v else v in

     

       227
       227
       +
         let rec convert (v : t) : Value.t =

     

       171
       228
        
           match v with

     

       172
       172
       -
           | `Scalar s ->

     

       173
       173
       -
               (match Scalar.anchor s with

     

       174
       174
       -
                | Some name -> Hashtbl.replace anchors name v

     

       175
       175
       -
                | None -> ())

     

       176
       176
       -
           | `Alias _ -> ()

     

       177
       177
       -
           | `A seq ->

     

       178
       178
       -
               (match Sequence.anchor seq with

     

       179
       179
       -
                | Some name -> Hashtbl.replace anchors name v

     

       180
       180
       -
                | None -> ());

     

       181
       181
       -
               List.iter collect (Sequence.members seq)

     

       229
       229
       +
           | `Scalar s -> scalar_to_value s

     

       230
       230
       +
           | `Alias name -> Error.raise (Unresolved_alias name)

     

       231
       231
       +
           | `A seq -> `A (List.map convert (Sequence.members seq))

     

       182
       232
        
           | `O map ->

     

       183
       183
       -
               (match Mapping.anchor map with

     

       184
       184
       -
                | Some name -> Hashtbl.replace anchors name v

     

       185
       185
       -
                | None -> ());

     

       186
       186
       -
               List.iter (fun (k, v) -> collect k; collect v) (Mapping.members map)

     

       187
       187
       -
         in

     

       188
       188
       -
         collect root;

     

       189
       189
       -
       

     

       190
       190
       -
         (* Second pass: resolve aliases *)

     

       191
       191
       -
         let rec resolve (v : t) : t =

     

       192
       192
       -
           match v with

     

       193
       193
       -
           | `Scalar _ -> v

     

       194
       194
       -
           | `Alias name ->

     

       195
       195
       -
               (match Hashtbl.find_opt anchors name with

     

       196
       196
       -
                | Some target -> resolve target

     

       197
       197
       -
                | None -> Error.raise (Undefined_alias name))

     

       198
       198
       -
           | `A seq ->

     

       199
       199
       -
               `A (Sequence.map resolve seq)

     

       200
       200
       -
           | `O map ->

     

       201
       201
       -
               `O (Mapping.make

     

       202
       202
       -
                     ?anchor:(Mapping.anchor map)

     

       203
       203
       -
                     ?tag:(Mapping.tag map)

     

       204
       204
       -
                     ~implicit:(Mapping.implicit map)

     

       205
       205
       -
                     ~style:(Mapping.style map)

     

       206
       206
       -
                     (List.map (fun (k, v) -> (resolve k, resolve v)) (Mapping.members map)))

     

       233
       233
       +
               `O (List.map (fun (k, v) ->

     

       234
       234
       +
                 let key = match k with

     

       235
       235
       +
                   | `Scalar s -> Scalar.value s

     

       236
       236
       +
                   | _ -> Error.raise (Type_mismatch ("string key", "complex key"))

     

       237
       237
       +
                 in

     

       238
       238
       +
                 (key, convert v)

     

       239
       239
       +
               ) (Mapping.members map))

     

       207
       240
        
         in

     

       208
       208
       -
         resolve root

     

       241
       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

···

       12
       12
        
       type error = Error.t

     

       13
       13
        
       exception Yamle_error = Error.Yamle_error

     

       14
       14
        
       

     

       15
       15
       +
       (** {1 Alias expansion limits (protection against billion laughs attack)} *)

     

       16
       16
       +
       

     

       17
       17
       +
       let default_max_alias_nodes = Yaml.default_max_alias_nodes

     

       18
       18
       +
       let default_max_alias_depth = Yaml.default_max_alias_depth

     

       19
       19
       +
       

     

       15
       20
        
       (** {1 JSON-compatible parsing} *)

     

       16
       21
        
       

     

       17
       17
       -
       let of_string s = Loader.value_of_string s

     

       22
       22
       +
       let of_string

     

       23
       23
       +
           ?(resolve_aliases = true)

     

       24
       24
       +
           ?(max_nodes = default_max_alias_nodes)

     

       25
       25
       +
           ?(max_depth = default_max_alias_depth)

     

       26
       26
       +
           s =

     

       27
       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
       38
       -
       let yaml_of_string s = Loader.yaml_of_string s

     

       48
       48
       +
       let yaml_of_string

     

       49
       49
       +
           ?(resolve_aliases = false)

     

       50
       50
       +
           ?(max_nodes = default_max_alias_nodes)

     

       51
       51
       +
           ?(max_depth = default_max_alias_depth)

     

       52
       52
       +
           s =

     

       53
       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
       70
       -
       let to_json yaml =

     

       71
       71
       -
         let yaml = Yaml.resolve_aliases yaml in

     

       72
       72
       -
         Yaml.to_value yaml

     

       85
       85
       +
       let to_json

     

       86
       86
       +
           ?(resolve_aliases = true)

     

       87
       87
       +
           ?(max_nodes = default_max_alias_nodes)

     

       88
       88
       +
           ?(max_depth = default_max_alias_depth)

     

       89
       89
       +
           yaml =

     

       90
       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

···

       1
       1
       +
       Billion laughs attack protection tests

     

       2
       2
       +
       

     

       3
       3
       +
       Create a small bomb file for testing:

     

       4
       4
       +
       

     

       5
       5
       +
         $ cat > bomb_small.yml << 'EOF'

     

       6
       6
       +
         > # Small "billion laughs" style YAML bomb for testing

     

       7
       7
       +
         > # Expands to 9^4 = 6561 nodes when aliases are resolved

     

       8
       8
       +
         > a: &a [1, 2, 3, 4, 5, 6, 7, 8, 9]

     

       9
       9
       +
         > b: &b [*a, *a, *a, *a, *a, *a, *a, *a, *a]

     

       10
       10
       +
         > c: &c [*b, *b, *b, *b, *b, *b, *b, *b, *b]

     

       11
       11
       +
         > d: &d [*c, *c, *c, *c, *c, *c, *c, *c, *c]

     

       12
       12
       +
         > EOF

     

       13
       13
       +
       

     

       14
       14
       +
       Test with a tight node limit (small bomb would expand to ~6561 nodes):

     

       15
       15
       +
       

     

       16
       16
       +
         $ yamlcat --max-nodes 100 --json bomb_small.yml

     

       17
       17
       +
         Error: alias expansion exceeded node limit (100 nodes)

     

       18
       18
       +
         [1]

     

       19
       19
       +
       

     

       20
       20
       +
       Test with a limit that allows the small bomb:

     

       21
       21
       +
       

     

       22
       22
       +
         $ yamlcat --max-nodes 10000 --json bomb_small.yml | head -c 100

     

       23
       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
       24
       +
       

     

       25
       25
       +
       Test depth limit with a nested alias chain:

     

       26
       26
       +
       

     

       27
       27
       +
         $ cat > depth_bomb.yml << 'EOF'

     

       28
       28
       +
         > a: &a [x, y, z]

     

       29
       29
       +
         > b: &b [*a, *a]

     

       30
       30
       +
         > c: &c [*b, *b]

     

       31
       31
       +
         > d: &d [*c, *c]

     

       32
       32
       +
         > e: &e [*d, *d]

     

       33
       33
       +
         > result: *e

     

       34
       34
       +
         > EOF

     

       35
       35
       +
       

     

       36
       36
       +
         $ yamlcat --max-depth 2 --json depth_bomb.yml

     

       37
       37
       +
         Error: alias expansion exceeded depth limit (2 levels)

     

       38
       38
       +
         [1]

     

       39
       39
       +
       

     

       40
       40
       +
         $ yamlcat --max-depth 10 --json depth_bomb.yml | head -c 50

     

       41
       41
       +
         {"a": ["x", "y", "z"], "b": [["x", "y", "z"], ["x"

     

       42
       42
       +
       

     

       43
       43
       +
       Test that --no-resolve-aliases keeps aliases as-is (in debug mode):

     

       44
       44
       +
       

     

       45
       45
       +
         $ cat > simple_alias.yml << 'EOF'

     

       46
       46
       +
         > anchor: &anc hello

     

       47
       47
       +
         > alias: *anc

     

       48
       48
       +
         > EOF

     

       49
       49
       +
       

     

       50
       50
       +
         $ yamlcat --no-resolve-aliases --debug simple_alias.yml

     

       51
       51
       +
         mapping(

     

       52
       52
       +
           style=block,

     

       53
       53
       +
           members={

     

       54
       54
       +
           scalar("anchor", style=plain): scalar("hello", anchor=anc, style=plain),

     

       55
       55
       +
           scalar("alias", style=plain): *anc

     

       56
       56
       +
         })

     

       57
       57
       +
       

     

       58
       58
       +
       With resolve (default), aliases are expanded:

     

       59
       59
       +
       

     

       60
       60
       +
         $ yamlcat --json simple_alias.yml

     

       61
       61
       +
         {"anchor": "hello", "alias": "hello"}

     

       62
       62
       +
       

     

       63
       63
       +
       Create a full bomb (like the one in ocaml-yaml):

     

       64
       64
       +
       

     

       65
       65
       +
         $ cat > bomb.yml << 'EOF'

     

       66
       66
       +
         > a: &a ["lol","lol","lol","lol","lol","lol","lol","lol","lol"]

     

       67
       67
       +
         > b: &b [*a,*a,*a,*a,*a,*a,*a,*a,*a]

     

       68
       68
       +
         > c: &c [*b,*b,*b,*b,*b,*b,*b,*b,*b]

     

       69
       69
       +
         > d: &d [*c,*c,*c,*c,*c,*c,*c,*c,*c]

     

       70
       70
       +
         > e: &e [*d,*d,*d,*d,*d,*d,*d,*d,*d]

     

       71
       71
       +
         > f: &f [*e,*e,*e,*e,*e,*e,*e,*e,*e]

     

       72
       72
       +
         > g: &g [*f,*f,*f,*f,*f,*f,*f,*f,*f]

     

       73
       73
       +
         > h: &h [*g,*g,*g,*g,*g,*g,*g,*g,*g]

     

       74
       74
       +
         > i: &i [*h,*h,*h,*h,*h,*h,*h,*h,*h]

     

       75
       75
       +
         > EOF

     

       76
       76
       +
       

     

       77
       77
       +
       Test the full bomb is rejected with default limits:

     

       78
       78
       +
       

     

       79
       79
       +
         $ yamlcat --json bomb.yml 2>&1 | head -1

     

       80
       80
       +
         Error: alias expansion exceeded node limit (10000000 nodes)

     

       81
       81
       +
       

     

       82
       82
       +
       With a very small limit:

     

       83
       83
       +
       

     

       84
       84
       +
         $ yamlcat --max-nodes 50 --json bomb.yml

     

       85
       85
       +
         Error: alias expansion exceeded node limit (50 nodes)

     

       86
       86
       +
         [1]

     

       87
       87
       +
       

     

       88
       88
       +
       Test that valid YAML with aliases works:

     

       89
       89
       +
       

     

       90
       90
       +
         $ cat > valid.yml << 'EOF'

     

       91
       91
       +
         > defaults: &defaults

     

       92
       92
       +
         >   timeout: 30

     

       93
       93
       +
         >   retries: 3

     

       94
       94
       +
         > production:

     

       95
       95
       +
         >   <<: *defaults

     

       96
       96
       +
         >   port: 8080

     

       97
       97
       +
         > EOF

     

       98
       98
       +
       

     

       99
       99
       +
         $ yamlcat --json valid.yml

     

       100
       100
       +
         {"defaults": {"timeout": 30, "retries": 3}, "production": {"<<": {"timeout": 30, "retries": 3}, "port": 8080}}

     

       101
       101
       +
       

     

       102
       102
       +
       Test help includes the new options:

     

       103
       103
       +
       

     

       104
       104
       +
         $ yamlcat --help=plain | grep 'max-nodes'

     

       105
       105
       +
                --max-nodes=N (absent=10000000)

     

       106
       106
       +
                  yamlcat --max-nodes 1000 --max-depth 10 untrusted.yaml

     

       107
       107
       +
       

     

       108
       108
       +
         $ yamlcat --help=plain | grep 'max-depth'

     

       109
       109
       +
                --max-depth=N (absent=100)

     

       110
       110
       +
                  yamlcat --max-nodes 1000 --max-depth 10 untrusted.yaml

     

       111
       111
       +
       

     

       112
       112
       +
         $ yamlcat --help=plain | grep 'no-resolve-aliases'

     

       113
       113
       +
                --no-resolve-aliases

yaml/ocaml-yamle/tests/cram/bomb_small.yml

···

       1
       1
       +
       # Small "billion laughs" style YAML bomb for testing

     

       2
       2
       +
       # Expands to 9^4 = 6561 nodes when aliases are resolved

     

       3
       3
       +
       a: &a [1, 2, 3, 4, 5, 6, 7, 8, 9]

     

       4
       4
       +
       b: &b [*a, *a, *a, *a, *a, *a, *a, *a, *a]

     

       5
       5
       +
       c: &c [*b, *b, *b, *b, *b, *b, *b, *b, *b]

     

       6
       6
       +
       d: &d [*c, *c, *c, *c, *c, *c, *c, *c, *c]

+81

yaml/ocaml-yamle/tests/test_yamle.ml

···

       248
       248
        
         "error position", `Quick, test_error_position;

     

       249
       249
        
       ]

     

       250
       250
        
       

     

       251
       251
       +
       (** Alias expansion limit tests (billion laughs protection) *)

     

       252
       252
       +
       

     

       253
       253
       +
       let test_node_limit () =

     

       254
       254
       +
         (* Small bomb that would expand to 9^4 = 6561 nodes *)

     

       255
       255
       +
         let yaml = {|

     

       256
       256
       +
       a: &a [1,2,3,4,5,6,7,8,9]

     

       257
       257
       +
       b: &b [*a,*a,*a,*a,*a,*a,*a,*a,*a]

     

       258
       258
       +
       c: &c [*b,*b,*b,*b,*b,*b,*b,*b,*b]

     

       259
       259
       +
       d: &d [*c,*c,*c,*c,*c,*c,*c,*c,*c]

     

       260
       260
       +
       |} in

     

       261
       261
       +
         (* Should fail with a small node limit *)

     

       262
       262
       +
         try

     

       263
       263
       +
           let _ = of_string ~max_nodes:100 yaml in

     

       264
       264
       +
           Alcotest.fail "expected node limit error"

     

       265
       265
       +
         with

     

       266
       266
       +
         | Yamle_error e ->

     

       267
       267
       +
             (match e.Error.kind with

     

       268
       268
       +
              | Error.Alias_expansion_node_limit _ -> ()

     

       269
       269
       +
              | _ -> Alcotest.fail "expected Alias_expansion_node_limit error")

     

       270
       270
       +
       

     

       271
       271
       +
       let test_depth_limit () =

     

       272
       272
       +
         (* Create deeply nested alias chain:

     

       273
       273
       +
            *e -> [*d,*d] -> [*c,*c] -> [*b,*b] -> [*a,*a] -> [x,y,z]

     

       274
       274
       +
            Each alias resolution increases depth by 1 *)

     

       275
       275
       +
         let yaml = {|

     

       276
       276
       +
       a: &a [x, y, z]

     

       277
       277
       +
       b: &b [*a, *a]

     

       278
       278
       +
       c: &c [*b, *b]

     

       279
       279
       +
       d: &d [*c, *c]

     

       280
       280
       +
       e: &e [*d, *d]

     

       281
       281
       +
       result: *e

     

       282
       282
       +
       |} in

     

       283
       283
       +
         (* Should fail with a small depth limit (depth 3 means max 3 alias hops) *)

     

       284
       284
       +
         try

     

       285
       285
       +
           let _ = of_string ~max_depth:3 yaml in

     

       286
       286
       +
           Alcotest.fail "expected depth limit error"

     

       287
       287
       +
         with

     

       288
       288
       +
         | Yamle_error e ->

     

       289
       289
       +
             (match e.Error.kind with

     

       290
       290
       +
              | Error.Alias_expansion_depth_limit _ -> ()

     

       291
       291
       +
              | _ -> Alcotest.fail ("expected Alias_expansion_depth_limit error, got: " ^ Error.kind_to_string e.Error.kind))

     

       292
       292
       +
       

     

       293
       293
       +
       let test_normal_aliases_work () =

     

       294
       294
       +
         (* Normal alias usage should work fine *)

     

       295
       295
       +
         let yaml = {|

     

       296
       296
       +
       defaults: &defaults

     

       297
       297
       +
         timeout: 30

     

       298
       298
       +
         retries: 3

     

       299
       299
       +
       production:

     

       300
       300
       +
         <<: *defaults

     

       301
       301
       +
         port: 8080

     

       302
       302
       +
       |} in

     

       303
       303
       +
         let result = of_string yaml in

     

       304
       304
       +
         match result with

     

       305
       305
       +
         | `O _ -> ()

     

       306
       306
       +
         | _ -> Alcotest.fail "expected mapping"

     

       307
       307
       +
       

     

       308
       308
       +
       let test_resolve_aliases_false () =

     

       309
       309
       +
         (* With resolve_aliases=false, aliases should remain unresolved *)

     

       310
       310
       +
         let yaml = {|

     

       311
       311
       +
       a: &anchor value

     

       312
       312
       +
       b: *anchor

     

       313
       313
       +
       |} in

     

       314
       314
       +
         let result = yaml_of_string ~resolve_aliases:false yaml in

     

       315
       315
       +
         (* Check that alias is preserved *)

     

       316
       316
       +
         match result with

     

       317
       317
       +
         | `O map ->

     

       318
       318
       +
             let pairs = Mapping.members map in

     

       319
       319
       +
             (match List.assoc_opt (`Scalar (Scalar.make "b")) pairs with

     

       320
       320
       +
              | Some (`Alias "anchor") -> ()

     

       321
       321
       +
              | _ -> Alcotest.fail "expected alias to be preserved")

     

       322
       322
       +
         | _ -> Alcotest.fail "expected mapping"

     

       323
       323
       +
       

     

       324
       324
       +
       let alias_limit_tests = [

     

       325
       325
       +
         "node limit", `Quick, test_node_limit;

     

       326
       326
       +
         "depth limit", `Quick, test_depth_limit;

     

       327
       327
       +
         "normal aliases work", `Quick, test_normal_aliases_work;

     

       328
       328
       +
         "resolve_aliases false", `Quick, test_resolve_aliases_false;

     

       329
       329
       +
       ]

     

       330
       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
       342
       +
           "alias_limits", alias_limit_tests;

     

       262
       343
        
         ]