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

Add an implementation for zone_of_json

Browse source
This commit is contained in:
jeltz 2022-08-30 01:58:52 +02:00
parent 429379ccf3
commit 570c40b434
Signed by: jeltz
GPG key ID: 800882B66C0C3326
2 changed files with 34 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
config.ml
View file

@ -17,8 +17,17 @@ type l4_rule =
type rule = { src : addrs list; dest : addrs list; l4 : l4_rule } type rule = { src : addrs list; dest : addrs list; l4 : l4_rule }
type config = { zones : (string * zone) list; rules : rule list } type config = { zones : (string * zone) list; rules : rule list }
(* TODO *) let rec zone_of_json json =
let zone_of_json _ = Zone "xxx" 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 addrs_of_json json =
let open Yojson.Basic.Util in let open Yojson.Basic.Util in

26
nftables.ml
View file

@ -3,7 +3,14 @@ open Ipaddr
type _ udp = UdpDport : int udp | UdpSport : int udp type _ udp = UdpDport : int udp | UdpSport : int udp
type _ tcp = TcpDport : int tcp | TcpSport : int tcp type _ tcp = TcpDport : int tcp | TcpSport : int tcp
type _ payload = Udp : 'a udp -> 'a payload | Tcp : 'a tcp -> 'a payload type _ ipv4 = Ipv4Saddr : V4.Prefix.t ipv4 | Ipv4Daddr : V4.Prefix.t ipv4
type _ ipv6 = Ipv6Saddr : V6.Prefix.t ipv6 | Ipv6Daddr : V6.Prefix.t ipv6
type _ payload =
| Udp : 'a udp -> 'a payload
| Tcp : 'a tcp -> 'a payload
| Ipv4 : 'a ipv4 -> 'a payload
| Ipv6 : 'a ipv6 -> 'a payload
type _ expr = type _ expr =
| String : string -> string expr | String : string -> string expr
@ -39,7 +46,7 @@ type _ stmt =
| NoTrack : unit stmt | NoTrack : unit stmt
| Log : { prefix : string option; group : int option } -> unit stmt | Log : { prefix : string option; group : int option } -> unit stmt
type family = Ip6 | Ip4 | Inet type family = FamilyIpv6 | FamilyIpv4 | FamilyInet
type table = { family : family; table_name : string } type table = { family : family; table_name : string }
type chain = { family : family; table : string; chain_name : string } type chain = { family : family; table : string; chain_name : string }
@ -66,11 +73,21 @@ let string_of_tcp : type a. a tcp -> string = function
| TcpSport -> "sport" | TcpSport -> "sport"
| TcpDport -> "dport" | TcpDport -> "dport"
let string_of_ipv4 : type a. a ipv4 -> string = function
| Ipv4Saddr -> "saddr"
| Ipv4Daddr -> "daddr"
let string_of_ipv6 : type a. a ipv6 -> string = function
| Ipv6Saddr -> "saddr"
| Ipv6Daddr -> "daddr"
let assoc_one key value = `Assoc [ (key, value) ] let assoc_one key value = `Assoc [ (key, value) ]
let json_of_payload (type a) (payload : a payload) = let json_of_payload (type a) (payload : a payload) =
let protocol, field = let protocol, field =
match payload with match payload with
| Ipv4 ipv4 -> ("ip", string_of_ipv4 ipv4)
| Ipv6 ipv6 -> ("ip6", string_of_ipv6 ipv6)
| Udp udp -> ("udp", string_of_udp udp) | Udp udp -> ("udp", string_of_udp udp)
| Tcp tcp -> ("tcp", string_of_tcp tcp) | Tcp tcp -> ("tcp", string_of_tcp tcp)
in in
@ -139,7 +156,10 @@ let json_of_stmt : type a. a stmt -> Yojson.Basic.t = function
in in
assoc_one "log" (`Assoc (deoptionalise elems)) assoc_one "log" (`Assoc (deoptionalise elems))
let string_of_family = function Ip6 -> "ip6" | Ip4 -> "ip4" | Inet -> "inet" let string_of_family = function
| FamilyIpv4 -> "ip"
| FamilyIpv6 -> "ip6"
| FamilyInet -> "inet"
let json_of_table { family; table_name } = let json_of_table { family; table_name } =
assoc_one "table" assoc_one "table"