Add support for JSON config files parsing
This commit is contained in:
parent
c1450c704c
commit
463513c4c8
1 changed files with 90 additions and 0 deletions
90
config.ml
Normal file
90
config.ml
Normal 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 }
|
Loading…
Reference in a new issue