aurore/firewall
10
0
Fork 0
Code Issues Pull requests Releases Activity

Create modules in config.ml

Browse source
This commit is contained in:
jeltz 2022-09-06 15:49:31 +02:00
parent aaba2f32ae
commit 41462c0d6d
Signed by: jeltz
GPG key ID: 800882B66C0C3326
1 changed files with 80 additions and 66 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

146
config.ml
View file

@ -1,88 +1,102 @@
open Ipaddr open Ipaddr
open Utils
type zone = module Zone = struct
| ZoneIpv4 of V4.Prefix.t type t =
| ZoneIpv6 of V6.Prefix.t | Ipv4 of V4.Prefix.t
| Zone of string | Ipv6 of V6.Prefix.t
| ZoneList of zone list | Name of string
| ZoneExclude of zone | List of t list
| Not of t
type addrs = ZoneName 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
type l4_rule = let rec of_json = function
| TcpRule of { sport : int list; dport : int list } | `String str ->
| UdpRule of { sport : int list; dport : int list } str |> V6.Prefix.of_string |> Result.map ipv6
| IcmpRule &?> (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
type rule = { src : addrs list; dest : addrs list; l4 : l4_rule } module Addrs = struct
type config = { zones : (string * zone) list; rules : rule list } type t = Name of string | Ipv4 of V4.Prefix.t | Ipv6 of V6.Prefix.t
let rec zone_of_json json = let name str = Name str
match json with let ipv4 prefix = Ipv4 prefix
| `String s -> ( let ipv6 prefix = Ipv6 prefix
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 of_json json =
let open Yojson.Basic.Util in let open Yojson.Basic.Util in
let value = json |> to_string in let str = json |> to_string in
let addrs = ZoneName value in str |> V6.Prefix.of_string |> Result.map ipv6
let addrs = &?> (str |> V4.Prefix.of_string |> Result.map ipv4)
match V6.Prefix.of_string value with Ok p -> Ipv6 p | Error _ -> addrs &> (str |> name)
in end
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 to_int_list json =
let open Yojson.Basic.Util in 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 = module PayloadRule = struct
let open Yojson.Basic.Util in module Tcp = struct
let sport = json |> member "sport" |> to_int_list in type t = { sport : int list; dport : int list }
let dport = json |> member "dport" |> to_int_list in
TcpRule { sport; dport }
let udp_rule_of_json json = let of_json json =
let open Yojson.Basic.Util in let open Yojson.Basic.Util in
let sport = json |> member "sport" |> to_int_list in let sport = json |> member "sport" |> to_int_list in
let dport = json |> member "dport" |> to_int_list in let dport = json |> member "dport" |> to_int_list in
UdpRule { sport; dport } { sport; dport }
end
let l4_rule_of_json json = module Udp = struct
let open Yojson.Basic.Util in type t = { sport : int list; dport : int list }
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 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 open Yojson.Basic.Util in
let src = addrs_list_of_json (json |> member "src") in json |> to_list |> List.map Addrs.of_json
let dest = addrs_list_of_json (json |> member "dest") in
let l4 = l4_rule_of_json json in module Rule = struct
{ src; dest; l4 } 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 zones_of_json json =
let open Yojson.Basic.Util in 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 open Yojson.Basic.Util in
let zones = json |> member "zones" |> zones_of_json 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 } { zones; rules }