firewall/nftables.ml

183 lines
5.3 KiB
OCaml
Raw Normal View History

2022-08-29 07:01:56 +02:00
open Utils
2022-08-29 08:36:19 +02:00
open Ipaddr
2022-08-29 07:01:56 +02:00
2022-08-29 21:13:13 +02:00
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
2022-08-29 07:01:56 +02:00
type _ expr =
| String : string -> string expr
| Number : int -> int expr
| Boolean : bool -> int expr
2022-08-29 21:13:13 +02:00
| Ipv4 : V4.Prefix.t -> V4.Prefix.t expr
| Ipv6 : V6.Prefix.t -> V6.Prefix.t expr
2022-08-29 07:01:56 +02:00
| List : 'a expr list -> 'a expr
| Set : 'a expr list -> 'a expr
| Range : 'a expr * 'a expr -> 'a expr
| Payload : 'a payload -> 'a expr
2022-08-29 21:13:13 +02:00
type (_, _) match_op = Eq : ('a, 'a) match_op | NotEq : ('a, 'a) match_op
type counter = Named of string | Anon of { packets : int; bytes : int }
2022-08-29 07:01:56 +02:00
type verdict =
| Accept
| Drop
| Continue
| Return
| Jump of string
| Goto of string
type _ stmt =
| Match : {
2022-08-29 21:13:13 +02:00
left : 'a expr;
right : 'b expr;
op : ('a, 'b) match_op;
}
-> unit stmt
2022-08-29 07:01:56 +02:00
| Counter : counter -> unit stmt
| Verdict : verdict -> unit stmt
| NoTrack : unit stmt
2022-08-29 21:13:13 +02:00
| Log : { prefix : string option; group : int option } -> unit stmt
2022-08-29 07:01:56 +02:00
type family = Ip6 | Ip4 | Inet
2022-08-29 21:13:13 +02:00
type table = { family : family; table_name : string }
type chain = { family : family; table : string; chain_name : string }
2022-08-29 07:01:56 +02:00
type rule = {
2022-08-29 21:13:13 +02:00
family : family;
table : string;
chain : string;
expr : unit stmt list;
2022-08-29 07:01:56 +02:00
}
2022-08-29 21:13:13 +02:00
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
2022-08-29 07:01:56 +02:00
let string_of_udp : type a. a udp -> string = function
| UdpSport -> "sport"
| UdpDport -> "dport"
let string_of_tcp : type a. a tcp -> string = function
| TcpSport -> "sport"
| TcpDport -> "dport"
2022-08-29 21:13:13 +02:00
let assoc_one key value = `Assoc [ (key, value) ]
2022-08-29 07:01:56 +02:00
let json_of_payload (type a) (payload : a payload) =
2022-08-29 21:13:13 +02:00
let protocol, field =
match payload with
| Udp udp -> ("udp", string_of_udp udp)
| Tcp tcp -> ("tcp", string_of_tcp tcp)
2022-08-29 07:01:56 +02:00
in
2022-08-29 21:13:13 +02:00
assoc_one "payload"
(`Assoc [ ("protocol", `String protocol); ("field", `String field) ])
2022-08-29 07:01:56 +02:00
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
2022-08-29 21:13:13 +02:00
| 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));
])
2022-08-29 07:01:56 +02:00
| List l -> `List (List.map json_of_expr l)
| Set s -> assoc_one "set" (`List (List.map json_of_expr s))
2022-08-29 21:13:13 +02:00
| Range (a, b) -> assoc_one "range" (`List [ json_of_expr a; json_of_expr b ])
2022-08-29 07:01:56 +02:00
| Payload p -> json_of_payload p
let string_of_match_op : type a b. (a, b) match_op -> string = function
| Eq -> "=="
| NotEq -> "!="
let json_of_counter = function
| Named n -> assoc_one "counter" (`String n)
| Anon { packets; bytes } ->
2022-08-29 21:13:13 +02:00
assoc_one "counter"
(`Assoc [ ("packets", `Int packets); ("bytes", `Int bytes) ])
2022-08-29 07:01:56 +02:00
let json_of_verdict = function
| Accept -> assoc_one "accept" `Null
| Drop -> assoc_one "drop" `Null
| Continue -> assoc_one "continue" `Null
| Return -> assoc_one "return" `Null
| Jump s -> assoc_one "jump" (assoc_one "target" (`String s))
| Goto s -> assoc_one "goto" (assoc_one "target" (`String s))
let json_of_stmt : type a. a stmt -> Yojson.Basic.t = function
| Match { left; right; op } ->
2022-08-29 21:13:13 +02:00
assoc_one "match"
(`Assoc
[
("left", json_of_expr left);
("right", json_of_expr right);
("op", `String (string_of_match_op op));
])
2022-08-29 07:01:56 +02:00
| Counter c -> json_of_counter c
| Verdict v -> json_of_verdict v
| NoTrack -> assoc_one "notrack" `Null
| Log { prefix; group } ->
2022-08-29 21:13:13 +02:00
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))
2022-08-29 07:01:56 +02:00
2022-08-29 21:13:13 +02:00
let string_of_family = function Ip6 -> "ip6" | Ip4 -> "ip4" | Inet -> "inet"
2022-08-29 07:01:56 +02:00
let json_of_table { family; table_name } =
2022-08-29 21:13:13 +02:00
assoc_one "table"
(`Assoc
[
("family", `String (string_of_family family));
("name", `String table_name);
])
2022-08-29 07:01:56 +02:00
let json_of_chain { family; table; chain_name } =
2022-08-29 21:13:13 +02:00
assoc_one "chain"
(`Assoc
[
("family", `String (string_of_family family));
("table", `String table);
("name", `String chain_name);
])
2022-08-29 07:01:56 +02:00
let json_of_rule { family; table; chain; expr } =
2022-08-29 21:13:13 +02:00
assoc_one "rule"
(`Assoc
[
("family", `String (string_of_family family));
("table", `String table);
("chain", `String chain);
("expr", `List (List.map json_of_stmt expr));
])
2022-08-29 07:01:56 +02:00
let json_of_add_object = function
| AddTable t -> json_of_table t
| AddChain c -> json_of_chain c
| AddRule r -> json_of_rule r
let json_of_flush_object = function
| FlushRuleset -> assoc_one "ruleset" `Null
| FlushTable t -> json_of_table t
| FlushChain c -> json_of_chain c
let json_of_command = function
| Add a -> assoc_one "add" (json_of_add_object a)
| Flush a -> assoc_one "flush" (json_of_flush_object a)
let json_of_nftables n =
assoc_one "nftables" (`List (List.map json_of_command n))