91 lines
2.3 KiB
OCaml
91 lines
2.3 KiB
OCaml
|
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 }
|