You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
113 lines
3.2 KiB
OCaml
113 lines
3.2 KiB
OCaml
open Ipaddr
|
|
open Utils
|
|
|
|
module Zone = struct
|
|
type t =
|
|
| Ipv4 of V4.Prefix.t
|
|
| Ipv6 of V6.Prefix.t
|
|
| Name of string
|
|
| List of t list
|
|
| Not of t
|
|
|
|
let name str = Name str
|
|
let ipv4 prefix = Ipv4 prefix
|
|
let ipv6 prefix = Ipv6 prefix
|
|
|
|
let rec of_json = function
|
|
| `String str ->
|
|
str |> V6.Prefix.of_string |> Result.map ipv6
|
|
&?> (str |> V6.of_string
|
|
|> Result.map V6.Prefix.of_addr
|
|
|> Result.map ipv6)
|
|
&?> (str |> V4.Prefix.of_string |> Result.map ipv4)
|
|
&?> (str |> V4.of_string
|
|
|> Result.map V4.Prefix.of_addr
|
|
|> Result.map ipv4)
|
|
&> (str |> name)
|
|
| `Assoc [ ("not", json) ] -> Not (of_json json)
|
|
| `List list -> List (List.map of_json list)
|
|
| _ -> failwith "invalid zone definition"
|
|
end
|
|
|
|
module Addrs = struct
|
|
type t = Name of string | Ipv4 of V4.Prefix.t | Ipv6 of V6.Prefix.t
|
|
|
|
let name str = Name str
|
|
let ipv4 prefix = Ipv4 prefix
|
|
let ipv6 prefix = Ipv6 prefix
|
|
|
|
let of_json json =
|
|
let open Yojson.Basic.Util in
|
|
let str = json |> to_string in
|
|
str |> V6.Prefix.of_string |> Result.map ipv6
|
|
&?> (str |> V6.of_string |> Result.map V6.Prefix.of_addr |> Result.map ipv6)
|
|
&?> (str |> V4.Prefix.of_string |> Result.map ipv4)
|
|
&?> (str |> V4.of_string |> Result.map V4.Prefix.of_addr |> Result.map ipv4)
|
|
&> (str |> name)
|
|
end
|
|
|
|
let to_list_loose = function `List list -> list | _ -> []
|
|
|
|
let to_int_list json =
|
|
let open Yojson.Basic.Util in
|
|
json |> to_list_loose |> List.map to_int
|
|
|
|
module PayloadRule = struct
|
|
module Tcp = struct
|
|
type t = { sport : int list; dport : int list }
|
|
|
|
let of_json json =
|
|
let open Yojson.Basic.Util in
|
|
let sport = json |> member "sport" |> to_int_list in
|
|
let dport = json |> member "dport" |> to_int_list in
|
|
{ sport; dport }
|
|
end
|
|
|
|
module Udp = struct
|
|
type t = { sport : int list; dport : int list }
|
|
|
|
let of_json json =
|
|
let open Yojson.Basic.Util in
|
|
let sport = json |> member "sport" |> to_int_list in
|
|
let dport = json |> member "dport" |> to_int_list in
|
|
{ sport; dport }
|
|
end
|
|
|
|
type t = Tcp of Tcp.t | Udp of Udp.t | Icmp
|
|
|
|
let of_json json =
|
|
let open Yojson.Basic.Util in
|
|
match json |> member "proto" |> to_string with
|
|
| "tcp" -> Tcp (Tcp.of_json json)
|
|
| "udp" -> Udp (Udp.of_json json)
|
|
| "icmp" -> Icmp
|
|
| proto -> failwith ("invalid protocol " ^ proto)
|
|
end
|
|
|
|
let to_addr_list json = json |> to_list_loose |> List.map Addrs.of_json
|
|
|
|
module Rule = struct
|
|
type t = { src : Addrs.t list; dest : Addrs.t list; payload : PayloadRule.t }
|
|
|
|
let of_json json =
|
|
let open Yojson.Basic.Util in
|
|
let src = json |> member "src" |> to_addr_list in
|
|
let dest = json |> member "dest" |> to_addr_list in
|
|
let payload = PayloadRule.of_json json in
|
|
{ src; dest; payload }
|
|
end
|
|
|
|
type t = { zones : (string * Zone.t) list; rules : Rule.t list }
|
|
|
|
let zones_of_json json =
|
|
let open Yojson.Basic.Util in
|
|
json |> to_assoc |> List.map (fun (n, z) -> (n, Zone.of_json z))
|
|
|
|
let of_json json =
|
|
let open Yojson.Basic.Util in
|
|
let zones = json |> member "zones" |> zones_of_json in
|
|
let rules =
|
|
json |> member "rules" |> to_list_loose |> List.map Rule.of_json
|
|
in
|
|
{ zones; rules }
|