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
(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)

182
nftables.ml
View file

@ -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