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

Format nftables.ml + simplify Ipv6

Browse source
This commit is contained in:
jeltz 2022-08-29 21:13:13 +02:00
parent 2bee462997
commit 397eebb638
Signed by: jeltz
GPG key ID: 800882B66C0C3326
2 changed files with 97 additions and 100 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
compile.ml
View file

@ -20,3 +20,18 @@ let compile_zones zones =
let compiled = compile_zone acc values in let compiled = compile_zone acc values in
(name, compiled) :: acc) sorted [] (name, compiled) :: acc) sorted []
| _ -> assert false | _ -> 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)

182
nftables.ml
View file

@ -1,36 +1,23 @@
open Utils open Utils
open Ipaddr open Ipaddr
type _ udp = type _ udp = UdpDport : int udp | UdpSport : int udp
| UdpDport : int udp type _ tcp = TcpDport : int tcp | TcpSport : int tcp
| UdpSport : int udp type _ payload = Udp : 'a udp -> 'a payload | Tcp : 'a tcp -> 'a payload
type _ tcp =
| TcpDport : int tcp
| TcpSport : int tcp
type _ payload =
| Udp : 'a udp -> 'a payload
| Tcp : 'a tcp -> 'a payload
type _ expr = type _ expr =
| String : string -> string expr | String : string -> string expr
| Number : int -> int expr | Number : int -> int expr
| Boolean : bool -> int expr | Boolean : bool -> int expr
| Ipv4 : (V4.t * V4.Prefix.t) -> (V4.t * V4.Prefix.t) expr | Ipv4 : V4.Prefix.t -> V4.Prefix.t expr
| Ipv6 : (V6.t * V6.Prefix.t) -> (V6.t * V6.Prefix.t) expr | Ipv6 : V6.Prefix.t -> V6.Prefix.t expr
| List : 'a expr list -> 'a expr | List : 'a expr list -> 'a expr
| Set : 'a expr list -> 'a expr | Set : 'a expr list -> 'a expr
| Range : 'a expr * 'a expr -> 'a expr | Range : 'a expr * 'a expr -> 'a expr
| Payload : 'a payload -> 'a expr | Payload : 'a payload -> 'a expr
type (_, _) match_op = type (_, _) match_op = Eq : ('a, 'a) match_op | NotEq : ('a, 'a) match_op
| Eq : ('a, 'a) match_op type counter = Named of string | Anon of { packets : int; bytes : int }
| NotEq : ('a, 'a) match_op
type counter =
| Named of string
| Anon of { packets: int; bytes: int }
type verdict = type verdict =
| Accept | Accept
@ -42,44 +29,30 @@ type verdict =
type _ stmt = type _ stmt =
| Match : { | Match : {
left: 'a expr; left : 'a expr;
right: 'b expr; right : 'b expr;
op: ('a, 'b) match_op op : ('a, 'b) match_op;
} -> unit stmt }
-> unit stmt
| Counter : counter -> unit stmt | Counter : counter -> unit stmt
| Verdict : verdict -> unit stmt | Verdict : verdict -> unit stmt
| NoTrack : unit stmt | NoTrack : unit stmt
| Log : { | Log : { prefix : string option; group : int option } -> unit stmt
prefix: string option;
group: int option
} -> unit stmt
type family = Ip6 | Ip4 | Inet type family = Ip6 | Ip4 | Inet
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 }
type rule = { type rule = {
family: family; family : family;
table: string; table : string;
chain: string; chain : string;
expr: unit stmt list expr : unit stmt list;
} }
type add_object = type add_object = AddTable of table | AddChain of chain | AddRule of rule
| AddTable of table type flush_object = FlushRuleset | FlushTable of table | FlushChain of chain
| AddChain of chain type command = Add of add_object | Flush of flush_object
| 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 let string_of_udp : type a. a udp -> string = function
| UdpSport -> "sport" | UdpSport -> "sport"
@ -89,34 +62,38 @@ let string_of_tcp : type a. a tcp -> string = function
| TcpSport -> "sport" | TcpSport -> "sport"
| TcpDport -> "dport" | 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 json_of_payload (type a) (payload : a payload) =
let (protocol, field) = match payload with let protocol, field =
| Udp udp -> "udp", string_of_udp udp match payload with
| Tcp tcp -> "tcp", string_of_tcp tcp | Udp udp -> ("udp", string_of_udp udp)
| Tcp tcp -> ("tcp", string_of_tcp tcp)
in in
assoc_one "payload" (`Assoc [ assoc_one "payload"
("protocol", `String protocol); (`Assoc [ ("protocol", `String protocol); ("field", `String field) ])
("field", `String field);
])
let rec json_of_expr : type a. a expr -> Yojson.Basic.t = function let rec json_of_expr : type a. a expr -> Yojson.Basic.t = function
| String s -> `String s | String s -> `String s
| Number n -> `Int n | Number n -> `Int n
| Boolean b -> `Bool b | Boolean b -> `Bool b
| Ipv4 (a, p) -> assoc_one "prefix" (`Assoc [ | Ipv4 i ->
("addr", `String (V4.to_string a)); assoc_one "prefix"
("len", `Int (V4.Prefix.bits p)) (`Assoc
]) [
| Ipv6 (a, p) -> assoc_one "prefix" (`Assoc [ ("addr", `String V4.(to_string (Prefix.network i)));
("addr", `String (V6.to_string a)); ("len", `Int (V4.Prefix.bits i));
("len", `Int (V6.Prefix.bits p)) ])
]) | 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) | List l -> `List (List.map json_of_expr l)
| Set s -> assoc_one "set" (`List (List.map json_of_expr s)) | Set s -> assoc_one "set" (`List (List.map json_of_expr s))
| Range (a, b) -> | Range (a, b) -> assoc_one "range" (`List [ json_of_expr a; json_of_expr b ])
assoc_one "range" (`List [json_of_expr a ; json_of_expr b])
| Payload p -> json_of_payload p | Payload p -> json_of_payload p
let string_of_match_op : type a b. (a, b) match_op -> string = function 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 let json_of_counter = function
| Named n -> assoc_one "counter" (`String n) | Named n -> assoc_one "counter" (`String n)
| Anon { packets; bytes } -> | Anon { packets; bytes } ->
assoc_one "counter" (`Assoc [ assoc_one "counter"
("packets", `Int packets); (`Assoc [ ("packets", `Int packets); ("bytes", `Int bytes) ])
("bytes", `Int bytes)
])
let json_of_verdict = function let json_of_verdict = function
| Accept -> assoc_one "accept" `Null | 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 let json_of_stmt : type a. a stmt -> Yojson.Basic.t = function
| Match { left; right; op } -> | Match { left; right; op } ->
assoc_one "match" (`Assoc [ assoc_one "match"
("left", json_of_expr left); (`Assoc
("right", json_of_expr right); [
("op", `String (string_of_match_op op)) ("left", json_of_expr left);
]) ("right", json_of_expr right);
("op", `String (string_of_match_op op));
])
| Counter c -> json_of_counter c | Counter c -> json_of_counter c
| Verdict v -> json_of_verdict v | Verdict v -> json_of_verdict v
| NoTrack -> assoc_one "notrack" `Null | NoTrack -> assoc_one "notrack" `Null
| Log { prefix; group } -> | Log { prefix; group } ->
let elems = [ let elems =
Option.map (fun p -> ("prefix", `String p)) prefix; [
Option.map (fun g -> ("group", `Int g)) group Option.map (fun p -> ("prefix", `String p)) prefix;
] in Option.map (fun g -> ("group", `Int g)) group;
assoc_one "log" (`Assoc (deoptionalise elems)) ]
in
assoc_one "log" (`Assoc (deoptionalise elems))
let string_of_family = function let string_of_family = function Ip6 -> "ip6" | Ip4 -> "ip4" | Inet -> "inet"
| Ip6 -> "ip6"
| Ip4 -> "ip4"
| Inet -> "inet"
let json_of_table { family; table_name } = let json_of_table { family; table_name } =
assoc_one "table" (`Assoc [ assoc_one "table"
("family", `String (string_of_family family)); (`Assoc
("name", `String table_name) [
]) ("family", `String (string_of_family family));
("name", `String table_name);
])
let json_of_chain { family; table; chain_name } = let json_of_chain { family; table; chain_name } =
assoc_one "chain" (`Assoc [ assoc_one "chain"
("family", `String (string_of_family family)); (`Assoc
("table", `String table); [
("name", `String chain_name) ("family", `String (string_of_family family));
]) ("table", `String table);
("name", `String chain_name);
])
let json_of_rule { family; table; chain; expr } = let json_of_rule { family; table; chain; expr } =
assoc_one "rule" (`Assoc [ assoc_one "rule"
("family", `String (string_of_family family)); (`Assoc
("table", `String table); [
("chain", `String chain); ("family", `String (string_of_family family));
("expr", `List (List.map json_of_stmt expr)) ("table", `String table);
]) ("chain", `String chain);
("expr", `List (List.map json_of_stmt expr));
])
let json_of_add_object = function let json_of_add_object = function
| AddTable t -> json_of_table t | AddTable t -> json_of_table t