From 397eebb638bc11a03d5bed526b532500bd2d2532 Mon Sep 17 00:00:00 2001 From: Jeltz Date: Mon, 29 Aug 2022 21:13:13 +0200 Subject: [PATCH] Format nftables.ml + simplify Ipv6 --- compile.ml | 15 +++++ nftables.ml | 182 +++++++++++++++++++++++----------------------------- 2 files changed, 97 insertions(+), 100 deletions(-) diff --git a/compile.ml b/compile.ml index 3e26023..acbec4d 100644 --- a/compile.ml +++ b/compile.ml @@ -20,3 +20,18 @@ let compile_zones zones = let compiled = compile_zone acc values in (name, compiled) :: acc) sorted [] | _ -> assert false + +let compile_rule zones { src; dest; l4 } = + let match_src = match src with + | [] -> [] + | l -> [] + in + let match_dest = match dest with + | [] -> [] + | l -> [] + in + let l4_rules = compile_l4 zones l4 in + List.flatten [match_src; match_dest; l4_rules] + +let compile_rules zones = + List.map (compile_rule zones) diff --git a/nftables.ml b/nftables.ml index 74a8afd..13992ba 100644 --- a/nftables.ml +++ b/nftables.ml @@ -1,36 +1,23 @@ open Utils open Ipaddr -type _ udp = - | UdpDport : int udp - | UdpSport : int udp - -type _ tcp = - | TcpDport : int tcp - | TcpSport : int tcp - -type _ payload = - | Udp : 'a udp -> 'a payload - | Tcp : 'a tcp -> 'a payload +type _ udp = UdpDport : int udp | UdpSport : int udp +type _ tcp = TcpDport : int tcp | TcpSport : int tcp +type _ payload = Udp : 'a udp -> 'a payload | Tcp : 'a tcp -> 'a payload type _ expr = | String : string -> string expr | Number : int -> int expr | Boolean : bool -> int expr - | Ipv4 : (V4.t * V4.Prefix.t) -> (V4.t * V4.Prefix.t) expr - | Ipv6 : (V6.t * V6.Prefix.t) -> (V6.t * V6.Prefix.t) expr + | Ipv4 : V4.Prefix.t -> V4.Prefix.t expr + | Ipv6 : V6.Prefix.t -> V6.Prefix.t expr | List : 'a expr list -> 'a expr | Set : 'a expr list -> 'a expr | Range : 'a expr * 'a expr -> 'a expr | Payload : 'a payload -> 'a expr -type (_, _) match_op = - | Eq : ('a, 'a) match_op - | NotEq : ('a, 'a) match_op - -type counter = - | Named of string - | Anon of { packets: int; bytes: int } +type (_, _) match_op = Eq : ('a, 'a) match_op | NotEq : ('a, 'a) match_op +type counter = Named of string | Anon of { packets : int; bytes : int } type verdict = | Accept @@ -42,44 +29,30 @@ type verdict = type _ stmt = | Match : { - left: 'a expr; - right: 'b expr; - op: ('a, 'b) match_op - } -> unit stmt + left : 'a expr; + right : 'b expr; + op : ('a, 'b) match_op; + } + -> unit stmt | Counter : counter -> unit stmt | Verdict : verdict -> 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 table = { family: family; table_name: string } - -type chain = { family: family; table: string; chain_name: string } +type table = { family : family; table_name : string } +type chain = { family : family; table : string; chain_name : string } type rule = { - family: family; - table: string; - chain: string; - expr: unit stmt list + family : family; + table : string; + chain : string; + expr : unit stmt list; } -type add_object = - | AddTable of table - | AddChain of chain - | AddRule of rule - -type flush_object = - | FlushRuleset - | FlushTable of table - | FlushChain of chain - -type command = - | Add of add_object - | Flush of flush_object +type add_object = AddTable of table | AddChain of chain | AddRule of rule +type flush_object = FlushRuleset | FlushTable of table | FlushChain of chain +type command = Add of add_object | Flush of flush_object let string_of_udp : type a. a udp -> string = function | UdpSport -> "sport" @@ -89,34 +62,38 @@ let string_of_tcp : type a. a tcp -> string = function | TcpSport -> "sport" | TcpDport -> "dport" -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 (protocol, field) = match payload with - | Udp udp -> "udp", string_of_udp udp - | Tcp tcp -> "tcp", string_of_tcp tcp + let protocol, field = + match payload with + | Udp udp -> ("udp", string_of_udp udp) + | Tcp tcp -> ("tcp", string_of_tcp tcp) in - assoc_one "payload" (`Assoc [ - ("protocol", `String protocol); - ("field", `String field); - ]) + assoc_one "payload" + (`Assoc [ ("protocol", `String protocol); ("field", `String field) ]) let rec json_of_expr : type a. a expr -> Yojson.Basic.t = function | String s -> `String s | Number n -> `Int n | Boolean b -> `Bool b - | Ipv4 (a, p) -> assoc_one "prefix" (`Assoc [ - ("addr", `String (V4.to_string a)); - ("len", `Int (V4.Prefix.bits p)) - ]) - | Ipv6 (a, p) -> assoc_one "prefix" (`Assoc [ - ("addr", `String (V6.to_string a)); - ("len", `Int (V6.Prefix.bits p)) - ]) + | Ipv4 i -> + assoc_one "prefix" + (`Assoc + [ + ("addr", `String V4.(to_string (Prefix.network i))); + ("len", `Int (V4.Prefix.bits i)); + ]) + | Ipv6 i -> + assoc_one "prefix" + (`Assoc + [ + ("addr", `String V6.(to_string (Prefix.network i))); + ("len", `Int (V6.Prefix.bits i)); + ]) | List l -> `List (List.map json_of_expr l) | Set s -> assoc_one "set" (`List (List.map json_of_expr s)) - | Range (a, b) -> - assoc_one "range" (`List [json_of_expr a ; json_of_expr b]) + | Range (a, b) -> assoc_one "range" (`List [ json_of_expr a; json_of_expr b ]) | Payload p -> json_of_payload p let string_of_match_op : type a b. (a, b) match_op -> string = function @@ -126,10 +103,8 @@ let string_of_match_op : type a b. (a, b) match_op -> string = function let json_of_counter = function | Named n -> assoc_one "counter" (`String n) | Anon { packets; bytes } -> - assoc_one "counter" (`Assoc [ - ("packets", `Int packets); - ("bytes", `Int bytes) - ]) + assoc_one "counter" + (`Assoc [ ("packets", `Int packets); ("bytes", `Int bytes) ]) let json_of_verdict = function | Accept -> assoc_one "accept" `Null @@ -141,46 +116,53 @@ let json_of_verdict = function let json_of_stmt : type a. a stmt -> Yojson.Basic.t = function | Match { left; right; op } -> - assoc_one "match" (`Assoc [ - ("left", json_of_expr left); - ("right", json_of_expr right); - ("op", `String (string_of_match_op op)) - ]) + assoc_one "match" + (`Assoc + [ + ("left", json_of_expr left); + ("right", json_of_expr right); + ("op", `String (string_of_match_op op)); + ]) | Counter c -> json_of_counter c | Verdict v -> json_of_verdict v | NoTrack -> assoc_one "notrack" `Null | Log { prefix; group } -> - let elems = [ - Option.map (fun p -> ("prefix", `String p)) prefix; - Option.map (fun g -> ("group", `Int g)) group - ] in - assoc_one "log" (`Assoc (deoptionalise elems)) + let elems = + [ + Option.map (fun p -> ("prefix", `String p)) prefix; + Option.map (fun g -> ("group", `Int g)) group; + ] + in + assoc_one "log" (`Assoc (deoptionalise elems)) -let string_of_family = function - | Ip6 -> "ip6" - | Ip4 -> "ip4" - | Inet -> "inet" +let string_of_family = function Ip6 -> "ip6" | Ip4 -> "ip4" | Inet -> "inet" let json_of_table { family; table_name } = - assoc_one "table" (`Assoc [ - ("family", `String (string_of_family family)); - ("name", `String table_name) - ]) + assoc_one "table" + (`Assoc + [ + ("family", `String (string_of_family family)); + ("name", `String table_name); + ]) let json_of_chain { family; table; chain_name } = - assoc_one "chain" (`Assoc [ - ("family", `String (string_of_family family)); - ("table", `String table); - ("name", `String chain_name) - ]) + assoc_one "chain" + (`Assoc + [ + ("family", `String (string_of_family family)); + ("table", `String table); + ("name", `String chain_name); + ]) let json_of_rule { family; table; chain; expr } = - assoc_one "rule" (`Assoc [ - ("family", `String (string_of_family family)); - ("table", `String table); - ("chain", `String chain); - ("expr", `List (List.map json_of_stmt expr)) - ]) + assoc_one "rule" + (`Assoc + [ + ("family", `String (string_of_family family)); + ("table", `String table); + ("chain", `String chain); + ("expr", `List (List.map json_of_stmt expr)); + ]) let json_of_add_object = function | AddTable t -> json_of_table t