From 41462c0d6dacdaeced557de1471de7ff12a7fa1a Mon Sep 17 00:00:00 2001 From: Jeltz Date: Tue, 6 Sep 2022 15:49:31 +0200 Subject: [PATCH] Create modules in config.ml --- config.ml | 156 +++++++++++++++++++++++++++++------------------------- 1 file changed, 85 insertions(+), 71 deletions(-) diff --git a/config.ml b/config.ml index 08dc90b..46855e5 100644 --- a/config.ml +++ b/config.ml @@ -1,88 +1,102 @@ open Ipaddr +open Utils -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 } - -let rec zone_of_json json = - match json with - | `String s -> ( - let zone = Zone s in - let zone = - match V6.Prefix.of_string s with Ok p -> ZoneIpv6 p | Error _ -> zone - in - match V4.Prefix.of_string s with Ok p -> ZoneIpv4 p | Error _ -> zone) - | `Assoc [ ("exclude", e) ] -> ZoneExclude (zone_of_json e) - | `List l -> ZoneList (List.map zone_of_json l) - | _ -> assert false - -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 +module Zone = struct + type t = + | Ipv4 of V4.Prefix.t + | Ipv6 of V6.Prefix.t + | Name of string + | List of t list + | Not of t + + let name str = Name str + let ipv4 prefix = Ipv4 prefix + let ipv6 prefix = Ipv6 prefix + + let rec of_json = function + | `String str -> + str |> V6.Prefix.of_string |> Result.map ipv6 + &?> (str |> V4.Prefix.of_string |> Result.map ipv4) + &> (str |> name) + | `Assoc [ ("not", json) ] -> Not (of_json json) + | `List list -> List (List.map of_json list) + | _ -> assert false +end -let to_list_force = function `List l -> l | _ -> [] +module Addrs = struct + type t = Name of string | Ipv4 of V4.Prefix.t | Ipv6 of V6.Prefix.t + + let name str = Name str + let ipv4 prefix = Ipv4 prefix + let ipv6 prefix = Ipv6 prefix + + let of_json json = + let open Yojson.Basic.Util in + let str = json |> to_string in + str |> V6.Prefix.of_string |> Result.map ipv6 + &?> (str |> V4.Prefix.of_string |> Result.map ipv4) + &> (str |> name) +end let to_int_list json = let open Yojson.Basic.Util in - json |> to_list_force |> List.map to_int + json |> to_list |> 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 } +module PayloadRule = struct + module Tcp = struct + type t = { sport : int list; dport : int list } -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 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 + { sport; dport } + end -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 = + module Udp = struct + type t = { sport : int list; dport : int list } + + let 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 + { sport; dport } + end + + type t = Tcp of Tcp.t | Udp of Udp.t | Icmp + + let of_json json = + let open Yojson.Basic.Util in + match json |> member "proto" |> to_string with + | "tcp" -> Tcp (Tcp.of_json json) + | "udp" -> Udp (Udp.of_json json) + | "icmp" -> Icmp + | _ -> assert false +end + +let to_addr_list 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 } + json |> to_list |> List.map Addrs.of_json + +module Rule = struct + type t = { src : Addrs.t list; dest : Addrs.t list; payload : PayloadRule.t } + + let of_json json = + let open Yojson.Basic.Util in + let src = json |> member "src" |> to_addr_list in + let dest = json |> member "dest" |> to_addr_list in + let payload = PayloadRule.of_json json in + { src; dest; payload } +end + +type t = { zones : (string * Zone.t) list; rules : Rule.t list } let zones_of_json json = let open Yojson.Basic.Util in - json |> to_assoc |> List.map (fun (n, z) -> (n, zone_of_json z)) + json |> to_assoc |> List.map (fun (n, z) -> (n, Zone.of_json z)) -let config_of_json json = +let 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 + let rules = json |> member "rules" |> to_list |> List.map Rule.of_json in { zones; rules }