From 189a7363680c2f0075a4c730d493f5321f04c122 Mon Sep 17 00:00:00 2001 From: Thomas Leonard Date: Wed, 17 Apr 2019 10:26:32 +0100 Subject: [PATCH] Add some types to the rules Before, we inferred the types from rules.ml and then the compiler checked that it was consistent with what firewall.ml expected. If it wasn't it reported the problem as being with firewall.ml, which could be confusing to users. --- packet.ml | 11 +++++++++++ rules.ml | 23 ++++------------------- 2 files changed, 15 insertions(+), 19 deletions(-) diff --git a/packet.ml b/packet.ml index 607fd37..97f1feb 100644 --- a/packet.ml +++ b/packet.ml @@ -25,3 +25,14 @@ type 'a info = { let is_tcp_start = function | `IPv4 (_ip, `TCP (hdr, _body)) -> Tcp.Tcp_packet.(hdr.syn && not hdr.ack) | _ -> false + +(* The possible actions we can take for a packet: *) +type action = [ + | `Accept (* Send the packet to its destination. *) + | `NAT (* Rewrite the packet's source field so packet appears to + have come from the firewall, via an unused port. + Also, add NAT rules so related packets will be translated accordingly. *) + | `NAT_to of host * port (* As for [`NAT], but also rewrite the packet's + destination fields so it will be sent to [host:port]. *) + | `Drop of string (* Drop the packet and log the given reason. *) +] diff --git a/rules.ml b/rules.ml index 7980469..352c98b 100644 --- a/rules.ml +++ b/rules.ml @@ -8,23 +8,6 @@ open Packet (* OCaml normally warns if you don't match all fields, but that's OK here. *) [@@@ocaml.warning "-9"] -(** {2 Actions} - - The possible actions are: - - - [`Accept] : Send the packet to its destination. - - - [`NAT] : Rewrite the packet's source field so packet appears to - have come from the firewall, via an unused port. - Also, add NAT rules so related packets will be translated accordingly. - - - [`NAT_to (host, port)] : - As for [`NAT], but also rewrite the packet's destination fields so it - will be sent to [host:port]. - - - [`Drop reason] drop the packet and log the reason. -*) - (* List your AppVM IP addresses here if you want to match on them in the rules below. Any client not listed here will appear as [`Client `Unknown]. *) let clients = [ @@ -44,7 +27,8 @@ let externals = [ (** Decide what to do with a packet from a client VM. Note: If the packet matched an existing NAT rule then this isn't called. *) -let from_client = function +let from_client (info : _ info) : action = + match info with (* Examples (add your own rules here): *) (* | { src = `Client `Dev; dst = `Client `Untrusted; proto = `TCP { dport = 22 } } -> `Accept @@ -59,5 +43,6 @@ let from_client = function (** Decide what to do with a packet received from the outside world. Note: If the packet matched an existing NAT rule then this isn't called. *) -let from_netvm = function +let from_netvm (info : _ info) : action = + match info with | _ -> `Drop "drop by default"