Add support for JSON config files parsing

This commit is contained in:
jeltz 2022-08-29 12:19:14 +02:00
parent c1450c704c
commit 463513c4c8
Signed by: jeltz
GPG key ID: 800882B66C0C3326

90
config.ml Normal file
View file

@ -0,0 +1,90 @@
open Ipaddr
type zone =
| ZoneIpv4 of V4.Prefix.t
| ZoneIpv6 of V6.Prefix.t
| Zone of string
| ZoneList of zone list
| ZoneExclude of zone
type addrs =
| ZoneName of string
| Ipv4 of V4.Prefix.t
| Ipv6 of V6.Prefix.t
type l4_rule =
| TcpRule of { sport: int list; dport: int list }
| UdpRule of { sport: int list; dport: int list }
| IcmpRule
type rule = { src: addrs list; dest: addrs list; l4: l4_rule }
type config = { zones: (string * zone) list; rules: rule list }
(* TODO *)
let zone_of_json _ =
Zone "xxx"
let addrs_of_json json =
let open Yojson.Basic.Util in
let value = json |> to_string in
let addrs = ZoneName value in
let addrs = match V6.Prefix.of_string value with
| Ok p -> Ipv6 p
| Error _ -> addrs
in
match V4.Prefix.of_string value with
| Ok p -> Ipv4 p
| Error _ -> addrs
let addrs_list_of_json json =
let open Yojson.Basic.Util in
let elems = json |> to_list in
List.map addrs_of_json elems
let to_list_force = function
| `List l -> l
| _ -> []
let to_int_list json =
let open Yojson.Basic.Util in
json |> to_list_force |> List.map to_int
let tcp_rule_of_json json =
let open Yojson.Basic.Util in
let sport = json |> member "sport" |> to_int_list in
let dport = json |> member "dport" |> to_int_list in
TcpRule { sport; dport }
let udp_rule_of_json json =
let open Yojson.Basic.Util in
let sport = json |> member "sport" |> to_int_list in
let dport = json |> member "dport" |> to_int_list in
UdpRule { sport; dport }
let l4_rule_of_json json =
let open Yojson.Basic.Util in
let proto = json |> member "proto" |> to_string in
match proto with
| "tcp" -> tcp_rule_of_json json
| "udp" -> udp_rule_of_json json
| "icmp" -> IcmpRule
| _ -> assert false
let rule_of_json json =
let open Yojson.Basic.Util in
let src = addrs_list_of_json (json |> member "src") in
let dest = addrs_list_of_json (json |> member "dest") in
let l4 = l4_rule_of_json json in
{ src; dest; l4 }
let zones_of_json json =
let open Yojson.Basic.Util in
json |> to_assoc |> List.map (fun (n, z) -> (n, zone_of_json z))
let config_of_json json =
let open Yojson.Basic.Util in
let zones = json |> member "zones" |> zones_of_json in
let rules = json |> member "rules" |> to_list |> List.map rule_of_json in
{ zones; rules }